├── .cargo └── config.toml ├── .clippy.toml ├── .github ├── dependabot.yml └── workflows │ ├── clippy.yml │ ├── ocaml.yml │ └── rust.yml ├── .gitignore ├── CHANGES.md ├── Cargo.toml ├── LICENSE.md ├── Makefile ├── README.md ├── TODO.md ├── build ├── Cargo.toml ├── README.md └── src │ ├── dune.rs │ └── lib.rs ├── derive ├── Cargo.toml ├── README.md └── src │ └── lib.rs ├── doc ├── book.toml └── src │ ├── 01_introduction.md │ ├── 02_type_conversion.md │ ├── 03_writing_ocaml_functions_in_rust.md │ ├── 04_linking_an_ocaml_library_into_a_rust_program.md │ └── SUMMARY.md ├── examples └── rust.rs ├── src ├── conv.rs ├── custom.rs ├── error.rs ├── lib.rs ├── macros.rs ├── pointer.rs ├── root.rs ├── runtime.rs ├── tag.rs ├── types.rs ├── util │ └── mod.rs └── value.rs ├── sys ├── Cargo.toml ├── build.rs └── src │ ├── alloc.rs │ ├── bigarray.rs │ ├── callback.rs │ ├── custom.rs │ ├── fail.rs │ ├── lib.rs │ ├── memory.rs │ ├── mlvalues.rs │ ├── ocaml-sys.c │ ├── printexc.rs │ ├── runtime.rs │ ├── state.rs │ └── tag.rs └── test ├── .cargo └── config.toml ├── Cargo.toml ├── build.rs ├── dune-project ├── ocamlrs-test.opam └── src ├── bench.ml ├── callbacks.ml ├── callbacks.rs ├── conv.ml ├── conv.rs ├── custom.ml ├── custom.rs ├── dune ├── lib.rs ├── runtime.ml ├── runtime.rs ├── rust.ml ├── rust.mli ├── types.ml ├── types.rs └── util.ml /.cargo/config.toml: -------------------------------------------------------------------------------- 1 | [build] 2 | rustflags = [] 3 | -------------------------------------------------------------------------------- /.clippy.toml: -------------------------------------------------------------------------------- 1 | single-char-binding-names-threshold = 50 2 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: cargo 4 | directory: "/" 5 | schedule: 6 | interval: daily 7 | time: "13:00" 8 | open-pull-requests-limit: 10 9 | ignore: 10 | - dependency-name: ndarray 11 | versions: 12 | - 0.15.0 13 | - dependency-name: ocaml-interop 14 | versions: 15 | - 0.6.0 16 | - 0.7.0 17 | -------------------------------------------------------------------------------- /.github/workflows/clippy.yml: -------------------------------------------------------------------------------- 1 | name: Clippy 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | branches: [master] 8 | 9 | jobs: 10 | stylecheck: 11 | name: Stylecheck 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: Checkout sources 15 | uses: actions/checkout@v3 16 | 17 | - name: Install stable toolchain with rustfmt and run cargo format in check mode 18 | uses: dtolnay/rust-toolchain@v1 19 | with: 20 | toolchain: stable 21 | components: rustfmt 22 | 23 | - name: Use OCaml 24 | uses: ocaml/setup-ocaml@v3 25 | with: 26 | ocaml-compiler: 4.14.1 27 | 28 | - run: cargo fmt --all -- --check 29 | 30 | clippy: 31 | runs-on: ubuntu-latest 32 | steps: 33 | - uses: actions/checkout@v3 34 | 35 | - name: Stable 36 | run: rustup toolchain install stable --profile=default 37 | 38 | - name: Use OCaml 39 | uses: ocaml/setup-ocaml@v3 40 | with: 41 | ocaml-compiler: 4.14.1 42 | 43 | - name: Run clippy 44 | run: opam exec -- cargo clippy --all -- -D warnings 45 | -------------------------------------------------------------------------------- /.github/workflows/ocaml.yml: -------------------------------------------------------------------------------- 1 | name: OCaml tests 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | workflow_dispatch: 9 | 10 | 11 | jobs: 12 | build-ubuntu: 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | ocaml-compiler: 17 | [ 18 | "5.2.0", 19 | "5.1.1", 20 | "5.0.0", 21 | "4.14.1", 22 | "4.13.1", 23 | "4.12.1", 24 | #"4.11.2", 25 | "4.10.2", 26 | ] 27 | runs-on: ubuntu-latest 28 | steps: 29 | - name: Checkout code 30 | uses: actions/checkout@v3 31 | - name: OCaml/Opam cache 32 | id: ocaml-rs-opam-cache 33 | uses: actions/cache@v3 34 | with: 35 | path: "~/.opam" 36 | key: ocaml-rs-opam-${{ matrix.ocaml-compiler }}-${{ matrix.os }} 37 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 38 | uses: ocaml/setup-ocaml@v3 39 | with: 40 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 41 | - if: matrix.os == 'macos-latest' 42 | run: brew install zstd 43 | - if: matrix.os == 'ubuntu-latest' 44 | run: sudo apt install libzstd-dev 45 | - run: opam install dune ppx_inline_test 46 | - name: Run OCaml tests 47 | run: opam exec -- dune runtest --root=./test 48 | 49 | # bench: 50 | # strategy: 51 | # matrix: 52 | # os: [macos-latest, ubuntu-latest] 53 | # ocaml-compiler: ["4.13.1"] 54 | # runs-on: ${{ matrix.os }} 55 | # steps: 56 | # - name: Checkout code 57 | # uses: actions/checkout@v2 58 | # - name: OCaml/Opam cache 59 | # id: ocaml-rs-opam-cache 60 | # uses: actions/cache@v2 61 | # with: 62 | # path: "~/.opam" 63 | # key: ocaml-rs-opam-${{ matrix.ocaml-compiler }}-${{ matrix.os }} 64 | # - name: Use OCaml ${{ matrix.ocaml-compiler }} 65 | # uses: avsm/setup-ocaml@v2 66 | # with: 67 | # ocaml-compiler: ${{ matrix.ocaml-compiler }} 68 | # - name: Set Opam env 69 | # run: opam env | tr '\n' ' ' >> $GITHUB_ENV 70 | # - name: Add Opam switch to PATH 71 | # run: opam var bin >> $GITHUB_PATH 72 | # - run: opam install dune ppx_inline_test notty bechamel-notty 73 | # - name: Run OCaml tests 74 | # run: opam exec -- dune exec --root=./test src/bench.exe 75 | -------------------------------------------------------------------------------- /.github/workflows/rust.yml: -------------------------------------------------------------------------------- 1 | name: Rust tests 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | branches: [master] 8 | workflow_dispatch: 9 | 10 | jobs: 11 | run: 12 | name: Build 13 | runs-on: ${{ matrix.os }} 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | os: [macos-latest, ubuntu-latest] 18 | ocaml-compiler: 19 | [ 20 | "5.2.0", 21 | "5.1.1", 22 | "5.0.0", 23 | "4.14.1", 24 | "4.13.1", 25 | "4.12.1", 26 | #"4.11.2", 27 | "4.10.2", 28 | ] 29 | 30 | steps: 31 | - name: Checkout code 32 | uses: actions/checkout@v3 33 | 34 | - name: OCaml/Opam cache 35 | id: ocaml-rs-opam-cache 36 | uses: actions/cache@v3 37 | with: 38 | path: "~/.opam" 39 | key: ocaml-rs-opam-${{ matrix.ocaml-compiler }}-${{ matrix.os }} 40 | 41 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 42 | uses: ocaml/setup-ocaml@v3 43 | with: 44 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 45 | 46 | - if: matrix.os == 'macos-latest' 47 | run: brew install zstd 48 | - if: matrix.os == 'ubuntu-latest' 49 | run: sudo apt install libzstd-dev 50 | 51 | - name: Install mdbook 52 | uses: baptiste0928/cargo-install@v2 53 | with: 54 | crate: mdbook 55 | 56 | - name: Build 57 | run: opam exec -- cargo build --example rust --features=link 58 | 59 | - name: Build build 60 | run: opam exec -- cargo build --package ocaml-build --features=dune 61 | 62 | - name: Run Rust tests 63 | run: opam exec -- cargo run --example rust --features=link 64 | 65 | - name: Check mdbook 66 | run: mdbook test doc -L ./target/debug/deps 67 | 68 | - name: Test `no_std` 69 | run: opam exec -- cargo build --features=no-std 70 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | .idea 3 | *.iml 4 | Cargo.lock 5 | *~ 6 | *.bk 7 | _build 8 | *.o 9 | *.cmx 10 | *.cmi 11 | *#* 12 | examples/ocaml/test 13 | *.merlin 14 | *.install 15 | doc/book 16 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## 1.2.0 2 | 3 | - Improve panic handler registration and update ocaml-boxroot-sys to 0.4.0 https://github.com/zshipko/ocaml-rs/pull/160 4 | 5 | ## 1.1.0 6 | 7 | - Support Caml_state definition as a macro by @Lupus in https://github.com/zshipko/ocaml-rs/pull/157 8 | 9 | ## 1.0.0 10 | 11 | - Minor improvements https://github.com/zshipko/ocaml-rs/pull/154 12 | - Fortran bigarray layout by @crackcomm https://github.com/zshipko/ocaml-rs/pull/145 13 | - Fix conversion of `Vec` by @gridbugs https://github.com/zshipko/ocaml-rs/pull/144 14 | 15 | ## 1.0.0-beta.5 16 | 17 | - Implement `ToValue` for `Box` by @fmckeogh https://github.com/zshipko/ocaml-rs/pull/107 18 | - Refactor derive macros for `FromValue` and `ToValue` 19 | - Drop support for OCaml 4.07 20 | 21 | ## 1.0.0-beta.4 22 | 23 | - Added `ocaml::function` macro for calling OCaml values 24 | - Fix spelling in book by @fmckeogh in https://github.com/zshipko/ocaml-rs/pull/98 25 | - Fixes no_std by @fmckeogh in https://github.com/zshipko/ocaml-rs/pull/99 26 | - Feature gate panic hook by @fmckeogh in https://github.com/zshipko/ocaml-rs/pull/100 27 | - Test `no_std` feature in CI by @fmckeogh in https://github.com/zshipko/ocaml-rs/pull/101 28 | - Implement `FromValue` for `Box` by @fmckeogh in https://github.com/zshipko/ocaml-rs/pull/105 29 | 30 | ## 1.0.0-beta.2 31 | 32 | - Added `Seq` type 33 | 34 | ## 1.0.0-beta.1 35 | 36 | - Add `ToValue`/`FromValue` implementations for `u32` 37 | 38 | ## 1.0.0-beta.0 39 | 40 | - Removed `IntoValue` and added `ToValue` because it now accepts a reference to self 41 | - `Custom` types now have to be wrapped in a `Pointer` 42 | - Added `ocaml::import!` macro for calling OCaml functions from Rust 43 | - Added `ocaml::sig` proc-macro for generating `external` and type signatures 44 | - Added ocaml-build crate for generating OCaml code from `ocaml::sig` macros and linking dune 45 | projects 46 | - Renamed `Value::call` to `Value::call1` and rewrote `Value::call` to take a variable number of 47 | arguments 48 | - Added support for automatic conversion between OCaml `Result.t` and Rust `Result` 49 | - Renamed `Value::float` to `Value::double` and `Value::float_val` to `Value::double_val` 50 | - Added `Value::alloc_double_array`, `Value::double_field` and `Value::store_double_field` 51 | - Improved support for float arrays in ocaml-sys 52 | - `Custom` values have a new default `finalize` implementation that will drop the inner Rust value 53 | 54 | ## 0.22.4 55 | 56 | - Added `Value::exn_to_string` to convert OCaml exception values to their string representation 57 | - Added `gc_minor`, `gc_major`, `gc_full_major` and `gc_compact` functions for interacting with 58 | the OCaml garbage collector 59 | 60 | ## 0.22.3 61 | 62 | - Use latest `ocaml-interop` 63 | 64 | ## 0.22.2 65 | 66 | - Adds `FromValue`/`ToValue` for `[u8]` 67 | 68 | ## 0.22.1 69 | 70 | - Add `no-caml-startup` feature to allow `ocaml-rs` libraries to link 71 | correctly when using `dune utop` 72 | 73 | ## 0.22.0 74 | 75 | - Allow `Value` to hold boxroot or raw value 76 | - Add `Raw::as_value` and `Raw::as_pointer` 77 | 78 | ## 0.21.0 79 | 80 | - New `Value` implementation to use `ocaml-boxroot-sys` 81 | * `Value` no longer implements `Copy` 82 | - `ocaml::Raw` was added to wrap `ocaml::sys::Value` in macros 83 | - Update `ocaml-interop` version 84 | 85 | ## 0.20.1 86 | 87 | - Fix issue with OCaml runtime initialization: https://github.com/zshipko/ocaml-rs/pull/59 88 | 89 | ## 0.20.0 90 | 91 | - `Value` methods marked as `unsafe`: the `Value` API is considered the "unsafe" API and `ocaml-interop` is the safer choice 92 | - `ToValue` renamed to `IntoValue` 93 | - All functions that cause OCaml allocations (including `IntoValue::into_value`) take a reference to `ocaml::Runtime`, which is provided by 94 | an implicit variable named `gc` when using `ocaml-derive` (the name of this variable is configurable: `#[ocaml::func(my_gc_var)]`) 95 | -------------------------------------------------------------------------------- /Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "ocaml" 3 | version = "1.2.0" 4 | authors = ["Zach Shipko "] 5 | readme = "README.md" 6 | keywords = ["ocaml", "rust", "ffi"] 7 | repository = "https://github.com/zshipko/ocaml-rs" 8 | license = "ISC" 9 | description = "OCaml bindings for Rust" 10 | documentation = "https://docs.rs/ocaml" 11 | edition = "2021" 12 | 13 | [package.metadata.docs.rs] 14 | no-default-features = true 15 | features = [ "derive", "without-ocamlopt", "ocaml5" ] 16 | 17 | [dependencies] 18 | ocaml-sys = {path = "./sys", version = ">=0.26"} 19 | ocaml-boxroot-sys = {version = "0.4.0", default-features = false} 20 | ocaml-derive = {path = "./derive", optional = true, version = "^1.0.0"} 21 | cstr_core = {version = "0.2", optional = true} 22 | ndarray = {version = "^0.16.1", optional = true} 23 | 24 | [features] 25 | default = ["derive", "boxroot"] 26 | # This is required for ocaml-rs to work correctly, it is only optional so docs.rs can build 27 | boxroot = ["ocaml-boxroot-sys/bundle-boxroot"] 28 | derive = ["ocaml-derive"] 29 | link = ["ocaml-sys/link", "boxroot"] 30 | without-ocamlopt = [ 31 | "ocaml-sys/without-ocamlopt", 32 | ] 33 | no-std = ["cstr_core/alloc", "no-panic-hook", "boxroot"] 34 | bigarray-ext = ["ndarray"] 35 | no-caml-startup = [] 36 | no-panic-hook = [] 37 | ocaml5 = ["ocaml-sys/ocaml5"] 38 | 39 | [workspace] 40 | members = [ 41 | "derive", 42 | "sys", 43 | "test", 44 | "build" 45 | ] 46 | 47 | [dev-dependencies] 48 | serial_test = "3.0.0" 49 | 50 | [[example]] 51 | name = "rust" 52 | required-features = ["link"] 53 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | ISC License 2 | 3 | Copyright (c) 2018, Zach Shipko 4 | 5 | Permission to use, copy, modify, and/or distribute this software for any 6 | purpose with or without fee is hereby granted, provided that the above 7 | copyright notice and this permission notice appear in all copies. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | test: test-rust test-ocaml 2 | 3 | test-rust: 4 | @cargo run --example rust --features=link 5 | 6 | test-ocaml: 7 | @dune clean --root=test 8 | @dune runtest --root=test --force --no-buffer 9 | 10 | test-book: 11 | @cargo clean 12 | @cargo build 13 | @mdbook test doc -L ./target/debug/deps 14 | 15 | build-book: 16 | @mdbook build doc 17 | 18 | utop: 19 | @dune utop --root=test 20 | 21 | clean: 22 | cargo clean 23 | dune clean --root=test 24 | mdbook clean doc || : 25 | 26 | publish-sys: 27 | cd sys && cargo package && cargo publish && sleep 20 28 | 29 | publish: 30 | cd derive && cargo package && cargo publish && sleep 20 31 | cd build && cargo package && cargo publish && sleep 20 32 | cargo package && cargo publish 33 | make deploy-book 34 | 35 | deploy-book: build-book 36 | @echo "====> deploying to github" 37 | git worktree remove /tmp/ocaml-rs-book || : 38 | git worktree add /tmp/ocaml-rs-book gh-pages 39 | mdbook build doc 40 | rm -rf /tmp/ocaml-rs-book/* 41 | cp -rp doc/book/* /tmp/ocaml-rs-book/ 42 | cd /tmp/ocaml-rs-book && \ 43 | git update-ref -d refs/heads/gh-pages && \ 44 | git add -A && \ 45 | git commit -m "deployed on $(shell date) by ${USER}" && \ 46 | git push origin gh-pages -f && \ 47 | rm -r /tmp/ocaml-rs-book 48 | 49 | .PHONY: test clean 50 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-rs - OCaml extensions in Rust 2 | 3 | 4 | 5 | 6 | 7 | `ocaml-rs` allows for OCaml extensions to be written directly in Rust with no C stubs. It was originally forked from [raml](https://crates.io/crates/raml), but has been almost entirely re-written thanks to support from the [OCaml Software Foundation](http://ocaml-sf.org/). 8 | 9 | Works with OCaml versions `4.10.0` and up 10 | 11 | Please report any issues on [github](https://github.com/zshipko/ocaml-rs/issues) 12 | 13 | NOTE: While `ocaml-rs` *can* be used safely, it does not prevent a wide range of potential errors or mistakes. It should be thought of as a Rust implementation of the existing C API. [ocaml-interop](https://github.com/simplestaking/ocaml-interop) can be used to perform safe OCaml/Rust interop. 14 | 15 | ### Documentation 16 | 17 | - [ocaml-rs Book](https://zshipko.github.io/ocaml-rs) 18 | - [docs.rs](https://docs.rs/ocaml) 19 | 20 | ### Getting started 21 | 22 | [ocaml-rust-starter](http://github.com/zshipko/ocaml-rust-starter) is a basic example to help get started with `ocaml-rs`. 23 | 24 | On the Rust side, you will need to add the following to your `Cargo.toml`: 25 | 26 | ```toml 27 | ocaml = "*" 28 | ``` 29 | 30 | or 31 | 32 | ```toml 33 | ocaml = {git = "https://github.com/zshipko/ocaml-rs"} 34 | ``` 35 | 36 | For macOS you will need also to add the following to your project's `.cargo/config` file: 37 | 38 | ```toml 39 | [build] 40 | rustflags = ["-C", "link-args=-Wl,-undefined,dynamic_lookup"] 41 | ``` 42 | 43 | This is because macOS doesn't allow undefined symbols in dynamic libraries by default. 44 | 45 | Additionally, if you plan on releasing to [opam](https://github.com/ocaml/opam), you will need to vendor your Rust dependencies to avoid making network requests during the build phase, since reaching out to crates.io/github will be blocked by the opam sandbox. To do this you should run: 46 | 47 | ```shell 48 | cargo vendor 49 | ``` 50 | 51 | then follow the instructions for editing `.cargo/config` 52 | 53 | ### Build options 54 | 55 | By default, building `ocaml-sys` will invoke the `ocamlopt` command to figure out the version and location of the OCaml compiler. There are a few environment variables to control this. 56 | 57 | - `OCAMLOPT` (default: `ocamlopt`) is the command that will invoke `ocamlopt` 58 | - `OCAML_VERSION` (default: result of `$OCAMLOPT -version`) is the target runtime OCaml version. 59 | - `OCAML_WHERE_PATH` (default: result of `$OCAMLOPT -where`) is the path of the OCaml standard library. 60 | - `OCAML_INTEROP_NO_CAML_STARTUP` (default: unset) can be set when loading an `ocaml-rs` library into an OCaml 61 | bytecode runtime (such as `utop`) to avoid linking issues with `caml_startup` 62 | 63 | If both `OCAML_VERSION` and `OCAML_WHERE_PATH` are present, their values are used without invoking `ocamlopt`. If any of those two env variables is undefined, then `ocamlopt` will be invoked to obtain both values. 64 | 65 | Defining the `OCAML_VERSION` and `OCAML_WHERE_PATH` variables is useful for saving time in CI environments where an OCaml install is not really required (to run `clippy` for example). 66 | 67 | ### Features 68 | 69 | - `derive` 70 | * enabled by default, adds `#[ocaml::func]` and friends and `derive` implementations for `FromValue` and `ToValue` 71 | - `link` 72 | * link the native OCaml runtime, this should only be used when no OCaml code will be linked statically 73 | - `no-std` 74 | * Allows `ocaml` to be used in `#![no_std]` environments like MirageOS 75 | 76 | 77 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - `in_channel`/`out_channel` (io.h) 2 | - Timing hooks (misc.h) 3 | - `caml_format_exception` (printexc.h) 4 | -------------------------------------------------------------------------------- /build/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "ocaml-build" 3 | version = "1.0.0" 4 | edition = "2021" 5 | authors = ["Zach Shipko "] 6 | license = "ISC" 7 | keywords = ["ocaml-rs", "build"] 8 | repository = "https://github.com/zshipko/ocaml-rs" 9 | description = "OCaml code generation" 10 | documentation = "https://docs.rs/ocaml-build" 11 | readme = "./README.md" 12 | 13 | [dependencies] 14 | syn = {version = "2", features =["full"]} 15 | proc-macro2 = "1" 16 | cc = {version = "1", optional=true} 17 | 18 | [features] 19 | dune = ["cc"] 20 | -------------------------------------------------------------------------------- /build/README.md: -------------------------------------------------------------------------------- 1 | # ocaml-build 2 | 3 | `ocaml-build` is used to generate an OCaml file containing signatures from Rust code 4 | 5 | For example, if you have this function (annotated with the `#[ocaml::sig(...)]` macro: 6 | 7 | ```rust 8 | #[ocaml::func] 9 | #[ocaml::sig("int -> bool")] 10 | pub fn greater_than_zero(i: ocaml::Int) -> bool { 11 | i > 0 12 | } 13 | ``` 14 | 15 | And the following build script: 16 | 17 | ```rust 18 | fn main() -> std::io::Result<()> { 19 | ocaml_build::Sigs::new("src/rust.ml").generate() 20 | } 21 | ``` 22 | 23 | The following code will be generated in `src/rust.ml`: 24 | 25 | ```ocaml 26 | external greater_than_zero: int -> bool = "greater_than_zero" 27 | ``` 28 | 29 | And a matching `mli` file will be created. 30 | -------------------------------------------------------------------------------- /build/src/dune.rs: -------------------------------------------------------------------------------- 1 | use std::path::{Path, PathBuf}; 2 | 3 | pub struct Dune { 4 | root: PathBuf, 5 | library: PathBuf, 6 | } 7 | 8 | impl Dune { 9 | pub fn new(library: impl AsRef) -> Dune { 10 | Dune { 11 | root: PathBuf::from(std::env::var("CARGO_MANIFEST_DIR").unwrap()), 12 | library: library.as_ref().to_path_buf(), 13 | } 14 | } 15 | 16 | pub fn with_root(mut self, root: impl AsRef) -> Dune { 17 | self.root = root.as_ref().to_path_buf(); 18 | self 19 | } 20 | 21 | fn run(&self) { 22 | let c = std::process::Command::new("dune") 23 | .current_dir(&self.root) 24 | .arg("build") 25 | .status() 26 | .unwrap(); 27 | assert!(c.success()); 28 | } 29 | 30 | pub fn build(self) { 31 | self.run(); 32 | 33 | let path = self.root.join("_build").join("default").join(&self.library); 34 | 35 | let mut build = cc::Build::new(); 36 | 37 | for file in std::fs::read_dir(&path).unwrap() { 38 | let file = file.unwrap(); 39 | let path = file.path(); 40 | if path.extension().map(|x| x.to_str().unwrap()) == Some("o") { 41 | build.object(&path); 42 | } 43 | } 44 | 45 | build.compile("ocaml"); 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /build/src/lib.rs: -------------------------------------------------------------------------------- 1 | use std::io::Write; 2 | use std::path::{Path, PathBuf}; 3 | 4 | #[cfg(feature = "dune")] 5 | mod dune; 6 | 7 | #[cfg(feature = "dune")] 8 | pub use dune::Dune; 9 | use syn::MetaList; 10 | use syn::__private::ToTokens; 11 | 12 | struct Source { 13 | path: PathBuf, 14 | functions: Vec, 15 | types: Vec, 16 | } 17 | 18 | pub struct Sigs { 19 | base_dir: PathBuf, 20 | output: PathBuf, 21 | source: Vec, 22 | } 23 | 24 | fn strip_quotes(s: &str) -> &str { 25 | s.trim_start_matches('"').trim_end_matches('"') 26 | } 27 | 28 | fn snake_case(s: &str) -> String { 29 | let mut dest = String::new(); 30 | for c in s.chars() { 31 | if !dest.is_empty() && c.is_uppercase() { 32 | dest.push('_'); 33 | } 34 | dest.push(c.to_ascii_lowercase()); 35 | } 36 | dest 37 | } 38 | 39 | fn handle(attrs: Vec, mut f: impl FnMut(&str)) { 40 | for attr in attrs { 41 | let attr_name = attr 42 | .path() 43 | .segments 44 | .iter() 45 | .map(|x| x.ident.to_string()) 46 | .collect::>() 47 | .join("::"); 48 | if attr_name == "sig" || attr_name == "ocaml::sig" { 49 | match &attr.meta { 50 | // #[sig] or #[ocaml::sig] 51 | syn::Meta::Path(_) => f(""), 52 | // #[ocaml::sig("...")] 53 | syn::Meta::List(MetaList { 54 | path: _, 55 | delimiter: _, 56 | tokens, 57 | }) => match &tokens.clone().into_iter().collect::>()[..] { 58 | [proc_macro2::TokenTree::Literal(ref sig)] => { 59 | let s = sig.to_string(); 60 | let ty = strip_quotes(&s); 61 | f(ty) 62 | } 63 | [] => f(""), 64 | x => { 65 | panic!("Invalid signature: {x:?}"); 66 | } 67 | }, 68 | syn::Meta::NameValue(x) => panic!("Invalid signature: {}", x.into_token_stream()), 69 | } 70 | } 71 | } 72 | } 73 | 74 | impl Sigs { 75 | pub fn new(p: impl AsRef) -> Sigs { 76 | let root = PathBuf::from(std::env::var("CARGO_MANIFEST_DIR").unwrap()); 77 | let base_dir = root.join("src"); 78 | Sigs { 79 | base_dir, 80 | output: p.as_ref().to_path_buf(), 81 | source: Vec::new(), 82 | } 83 | } 84 | 85 | pub fn with_source_dir(mut self, p: impl AsRef) -> Sigs { 86 | self.base_dir = p.as_ref().to_path_buf(); 87 | self 88 | } 89 | 90 | fn parse(&mut self, path: &Path) -> Result<(), std::io::Error> { 91 | let files = std::fs::read_dir(path)?; 92 | 93 | for file in files { 94 | let file = file?; 95 | if file.metadata()?.is_dir() { 96 | self.parse(&file.path())?; 97 | continue; 98 | } 99 | 100 | if Some(Some("rs")) != file.path().extension().map(|x| x.to_str()) { 101 | continue; 102 | } 103 | 104 | let path = file.path(); 105 | let mut src = Source { 106 | path: path.clone(), 107 | functions: Vec::new(), 108 | types: Vec::new(), 109 | }; 110 | let s = std::fs::read_to_string(&path)?; 111 | let t: syn::File = syn::parse_str(&s) 112 | .unwrap_or_else(|_| panic!("Unable to parse input file: {}", path.display())); 113 | 114 | for item in t.items { 115 | match item { 116 | syn::Item::Fn(item_fn) => { 117 | let name = &item_fn.sig.ident; 118 | handle(item_fn.attrs, |ty| { 119 | let def = if item_fn.sig.inputs.len() > 5 { 120 | format!("external {name}: {ty} = \"{name}_bytecode\" \"{name}\"") 121 | } else { 122 | format!("external {name}: {ty} = \"{name}\"") 123 | }; 124 | src.functions.push(def); 125 | }); 126 | } 127 | syn::Item::Struct(item) => { 128 | let name = snake_case(&item.ident.to_string()); 129 | handle(item.attrs, |ty| { 130 | let def = if ty.is_empty() { 131 | format!("type {name}") 132 | } else if !ty.trim_start().starts_with('{') { 133 | format!("type {}{name}{} = {ty}", '{', '}') 134 | } else { 135 | format!("type {name} = {ty}") 136 | }; 137 | src.types.push(def); 138 | }); 139 | } 140 | syn::Item::Enum(item) => { 141 | let name = snake_case(&item.ident.to_string()); 142 | handle(item.attrs, |ty| { 143 | let def = if ty.is_empty() { 144 | format!("type {name}") 145 | } else { 146 | format!("type {name} = {ty}") 147 | }; 148 | src.types.push(def); 149 | }); 150 | } 151 | syn::Item::Type(item) => { 152 | let name = snake_case(&item.ident.to_string()); 153 | handle(item.attrs, |_ty| src.types.push(format!("type {name}"))); 154 | } 155 | _ => (), 156 | } 157 | } 158 | 159 | if !src.functions.is_empty() || !src.types.is_empty() { 160 | self.source.push(src); 161 | } 162 | } 163 | 164 | Ok(()) 165 | } 166 | 167 | fn generate_ml(&mut self) -> Result<(), std::io::Error> { 168 | let mut f = std::fs::File::create(&self.output).unwrap(); 169 | 170 | writeln!(f, "(* Generated by ocaml-rs *)\n")?; 171 | writeln!(f, "open! Bigarray")?; 172 | 173 | for src in &self.source { 174 | writeln!( 175 | f, 176 | "\n(* file: {} *)\n", 177 | src.path.strip_prefix(&self.base_dir).unwrap().display() 178 | )?; 179 | 180 | for t in &src.types { 181 | writeln!(f, "{t}")?; 182 | } 183 | 184 | for func in &src.functions { 185 | writeln!(f, "{func}")?; 186 | } 187 | } 188 | 189 | Ok(()) 190 | } 191 | 192 | fn generate_mli(&mut self) -> Result<(), std::io::Error> { 193 | let filename = self.output.with_extension("mli"); 194 | let mut f = std::fs::File::create(filename).unwrap(); 195 | 196 | writeln!(f, "(* Generated by ocaml-rs *)\n")?; 197 | writeln!(f, "open! Bigarray")?; 198 | 199 | for src in &self.source { 200 | writeln!( 201 | f, 202 | "\n(* file: {} *)\n", 203 | src.path.strip_prefix(&self.base_dir).unwrap().display() 204 | )?; 205 | 206 | for t in &src.types { 207 | writeln!(f, "{t}")?; 208 | } 209 | 210 | for func in &src.functions { 211 | writeln!(f, "{func}")?; 212 | } 213 | } 214 | 215 | Ok(()) 216 | } 217 | 218 | pub fn generate(mut self) -> Result<(), std::io::Error> { 219 | let dir = self.base_dir.clone(); 220 | self.parse(&dir)?; 221 | 222 | self.source.sort_by(|a, b| a.path.cmp(&b.path)); 223 | self.generate_ml()?; 224 | self.generate_mli() 225 | } 226 | } 227 | -------------------------------------------------------------------------------- /derive/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "ocaml-derive" 3 | version = "1.0.0" 4 | authors = ["Zach Shipko "] 5 | license = "ISC" 6 | keywords = ["ocaml-rs", "proc-macro"] 7 | repository = "https://github.com/zshipko/ocaml-rs" 8 | description = "OCaml procedural macros" 9 | documentation = "https://docs.rs/ocaml-derive" 10 | readme = "./README.md" 11 | edition = "2021" 12 | 13 | [lib] 14 | proc-macro = true 15 | 16 | [dependencies] 17 | syn = {version = "2", features = ["full"]} 18 | proc-macro2 = {version = "1"} 19 | quote = "1" 20 | -------------------------------------------------------------------------------- /derive/README.md: -------------------------------------------------------------------------------- 1 | # ocaml-derive 2 | 3 | Provides `ocaml_func`, `ocaml_bare_func`, `ocaml_sig`, `derive(IntoValue)` and `derive(FromValue)` 4 | 5 | - `src/lib.rs` contains definitions `ocaml_func`, `ocaml_bare_func` and `ocaml_sig` 6 | - `src/derive.rs` is forked from [rust-ocaml-derive](https://github.com/rust-ocaml-derive) to remain in parity with `ocaml-rs` 7 | -------------------------------------------------------------------------------- /doc/book.toml: -------------------------------------------------------------------------------- 1 | [book] 2 | authors = ["Zach Shipko"] 3 | language = "en" 4 | multilingual = false 5 | src = "./src" 6 | title = "ocaml-rs" 7 | -------------------------------------------------------------------------------- /doc/src/01_introduction.md: -------------------------------------------------------------------------------- 1 | [ocaml-rs](https://github.com/zshipko/ocaml-rs) is a Rust crate for interacting with the OCaml runtime. It allows you to write functions in Rust that can be called from OCaml and vice-versa. `ocaml-rs` also does automatic conversion between OCaml and Rust representations. There are several crates that make this possible: 2 | 3 | * [ocaml-sys](https://crates.io/crates/ocaml-sys) - Low level bindings to the OCaml runtime 4 | * [ocaml-boxroot-sys](https://crates.io/crates/ocaml-boxroot-sys) - Bindings to [ocaml-boxroot](https://gitlab.com/ocaml-rust/ocaml-boxroot/), which handles safe allocation of OCaml values 5 | * [ocaml-derive](https://crates.io/crates/ocaml-derive) - Procedural macros: `ocaml::func`, `ocaml::sig`, `derive(FromValue)`, `derive(ToValue)` 6 | * [ocaml-build](https://crates.io/crates/ocaml-build) - Generate OCaml interfaces from `ocaml::sig` definitions 7 | * [ocaml](https://crates.io/crates/ocaml) - Higher level bindings built using the crates listed above 8 | 9 | Before going any further, it may be helpful to read through the [Interfacing C with OCaml](https://v2.ocaml.org/manual/intfc.html) from the OCaml handbook if you haven't already! 10 | 11 | ## Initial setup 12 | 13 | This section will cover how to set up a Rust crate that is linked into an OCaml program. If you're interested in calling into an OCaml library from Rust instead, see [Linking an OCaml library into a Rust program](./04_linking_an_ocaml_library_into_a_rust_program.md). 14 | 15 | Add the following to your `Cargo.toml`: 16 | 17 | ```toml 18 | [lib] 19 | crate-type = ["staticlib"] # You can also use cdylib, depending on your project 20 | 21 | [dependencies] 22 | ocaml = "*" 23 | ``` 24 | 25 | Additionally, on macOS you may need to add a `.cargo/config` with the following: 26 | 27 | ```toml 28 | [build] 29 | rustflags = ["-C", "link-args=-Wl,-undefined,dynamic_lookup"] 30 | ``` 31 | 32 | This is because macOS doesn't allow undefined symbols in dynamic libraries by default. 33 | 34 | If you plan on using `ocaml-build`: 35 | 36 | ```toml 37 | [build-dependencies] 38 | ocaml-build = "*" 39 | ``` 40 | 41 | And add a `build.rs`: 42 | 43 | ```rust,ignore 44 | # extern crate ocaml_build; 45 | pub fn main() -> std::io::Result<()> { 46 | ocaml_build::Sigs::new("src/rust.ml").generate() 47 | } 48 | ``` 49 | 50 | This build script will look for usages of `#[ocaml::sig(...)]` to generate OCaml bindings. 51 | 52 | Next you will need to add setup a [dune](https://dune.build) project to handle compilation of your OCaml code. Here is an example `dune` file that will link your Rust project, in this case the Rust crate is named `example`: 53 | 54 | ```ignore 55 | (rule 56 | (targets libexample.a) 57 | (deps (glob_files *.rs)) 58 | (action 59 | (progn 60 | (run cargo build --target-dir %{project_root}/../../target --release) 61 | (run mv %{project_root}/../../target/release/libexample.a libexample.a)))) 62 | 63 | (library 64 | (name example) 65 | (public_name example) 66 | (foreign_archives example) 67 | (c_library_flags 68 | (-lpthread -lc -lm))) 69 | ``` 70 | 71 | You should also add the following stanza to a `dune` file at the root of your project to ignore the `target` directory: 72 | 73 | ```ignore 74 | (dirs :standard \ target) 75 | ``` 76 | 77 | It can take a little trial and error to get this right depending on the specifics of your project! 78 | 79 | Additionally, if you plan on releasing to [opam](https://github.com/ocaml/opam), you will need to vendor your Rust dependencies to avoid making network requests during the build phase, since reaching out to crates.io/github will be blocked by the opam sandbox. To do this you should run: 80 | 81 | ```shell 82 | cargo vendor 83 | ``` 84 | then follow the instructions for editing `.cargo/config` 85 | 86 | To simplify the full setup process, take a look at [ocaml-rust-starter](https://github.com/zshipko/ocaml-rust-starter). 87 | 88 | ## Build options 89 | 90 | By default, building `ocaml-sys` will invoke the `ocamlopt` command to figure out the version and location of the OCaml compiler. There are a few environment variables to control this. 91 | 92 | - `OCAMLOPT` (default: `ocamlopt`) is the command that will invoke `ocamlopt` 93 | - `OCAML_VERSION` (default: result of `$OCAMLOPT -version`) is the target runtime OCaml version. 94 | - `OCAML_WHERE_PATH` (default: result of `$OCAMLOPT -where`) is the path of the OCaml standard library. 95 | - `OCAML_INTEROP_NO_CAML_STARTUP` (default: unset) can be set when loading an `ocaml-rs` library into an OCaml 96 | bytecode runtime (such as `utop`) to avoid linking issues with `caml_startup` 97 | 98 | If both `OCAML_VERSION` and `OCAML_WHERE_PATH` are present, their values are used without invoking `ocamlopt`. If any of those two env variables is undefined, then `ocamlopt` will be invoked to obtain both values. 99 | 100 | Defining the `OCAML_VERSION` and `OCAML_WHERE_PATH` variables is useful for saving time in CI environments where an OCaml install is not really required (to run `clippy` for example). 101 | 102 | ### Features 103 | 104 | - `derive` 105 | * enabled by default, adds `#[ocaml::func]` and friends and `derive` implementations for `FromValue` and `ToValue` 106 | - `link` 107 | * link the native OCaml runtime, this should only be used when no OCaml code will be linked statically 108 | - `no-std` 109 | * Allows `ocaml` to be used in `#![no_std]` environments like MirageOS 110 | 111 | 112 | ## Writing your first `ocaml::func` 113 | 114 | [ocaml::func](https://docs.rs/ocaml/latest/ocaml/attr.func.html) is the highest-level macro that can be used to generate OCaml functions. It's built on `ocaml::native_func` which only works on `Value` parameters and `ocaml::bytecode_func` which is used for generating bytecode functions. `ocaml::func` will take care of generating bytecode bindings for functions with more than five parameters as required by the OCaml runtime. `ocaml::func` handles using `CAMLparam`/`CAMLlocal`/`CAMLreturn` correctly for you, often making it much easier to write bindings than using the C API directly, particularly for those who haven't used the OCaml C API before. 115 | 116 | All `ocaml::func`'s have an implicit `gc` variable which is used to access the OCaml runtime. To pick another name you can provide it as an argument to the `ocaml::func` macro: 117 | 118 | ```rust,ignore 119 | #[ocaml::func(my_gc_name)] 120 | ... 121 | ``` 122 | 123 | The following example will read a file and return the contents, we will ignore error handling for now since that will be covered later - however, one thing worth mentioning is that Rust panics will be converted into OCaml exceptions. 124 | 125 | ```rust 126 | # extern crate ocaml; 127 | 128 | #[ocaml::func] // This is needed to make the function compatible with OCaml 129 | #[ocaml::sig("string -> string")] /// This is used to generate the OCaml bindings 130 | pub unsafe fn read_file(filename: String) -> String { 131 | std::fs::read_to_string(filename).unwrap() 132 | } 133 | ``` 134 | 135 | In the above example, automatic conversion is performed between OCaml strings and Rust strings. The next section will provide a table of valid conversions before getting into more details about writing functions and calling OCaml functions from Rust. 136 | -------------------------------------------------------------------------------- /doc/src/02_type_conversion.md: -------------------------------------------------------------------------------- 1 | # Type conversion 2 | 3 | As mentioned in the previous section, `ocaml-rs` automates the conversion between Rust and OCaml representations for many types. This is done using two traits: [ToValue](https://docs.rs/ocaml/latest/ocaml/trait.ToValue.html), which is implemented for types that can be converted to an OCaml value and [FromValue](https://docs.rs/ocaml/latest/ocaml/trait.FromValue.html) for types that can be converted from an OCaml value. 4 | 5 | Below is a list of types that implement these traits in `ocaml-rs` and their corresponding OCaml type: 6 | 7 | | Rust type | OCaml type | 8 | | ------------------------- | -------------------- | 9 | | `()` | `unit` | 10 | | `isize` | `int` | 11 | | `usize` | `int` | 12 | | `i8` | `int` | 13 | | `u8` | `int` | 14 | | `i16` | `int` | 15 | | `u16` | `int` | 16 | | `i32` | `int32` | 17 | | `u32` | `int32` | 18 | | `i64` | `int64` | 19 | | `u64` | `int64` | 20 | | `f32` | `float` | 21 | | `f64` | `float` | 22 | | `str` | `string` | 23 | | `[u8]` | `bytes` | 24 | | `String` | `string` | 25 | | `Option` | `'a option` | 26 | | `Result` | `'a` or `exception` | 27 | | `Result` | `('a, 'b) Result.t` | 28 | | `(A, B, C)` | `'a * 'b * 'c` | 29 | | `&[Value]` | `'a array` (no copy) | 30 | | `Vec`, `&[A]` | `'a array` | 31 | | `BTreeMap` | `('a, 'b) list` | 32 | | `LinkedList` | `'a list` | 33 | | `Seq` | `'a Seq.t` | 34 | 35 | NOTE: Even though `&[Value]` is specifically marked as no copy, any type like `Option` would also qualify since the inner value is not converted to a Rust type. However, `Option` will do full unmarshaling into Rust types. Another thing to note: `FromValue` for `str` and `&[u8]` is zero-copy, however `ToValue` for `str` and `&[u8]` creates a new value - this is necessary to ensure the string is registered with the OCaml runtime. 36 | 37 | If you're concerned with minimizing allocations/conversions you should use `Value` type directly. 38 | 39 | ## Implementing `ToValue` and `FromValue` 40 | 41 | The [ToValue](https://docs.rs/ocaml/latest/ocaml/trait.ToValue.html) trait has a single function, `to_value` which takes a reference to `self`, a reference to [Runtime] and returns a [Value](https://docs.rs/ocaml/latest/ocaml/enum.Value.html) and [FromValue](https://docs.rs/ocaml/latest/ocaml/trait.FromValue.html) has `from_value`, which takes a `Value` and returns `Self`: 42 | 43 | ```rust 44 | # extern crate ocaml; 45 | 46 | pub struct MyType(i32); 47 | 48 | unsafe impl ocaml::ToValue for MyType { 49 | fn to_value(&self, _gc: &ocaml::Runtime) -> ocaml::Value { 50 | unsafe { ocaml::Value::int32(self.0) } 51 | } 52 | } 53 | 54 | unsafe impl ocaml::FromValue for MyType { 55 | fn from_value(value: ocaml::Value) -> MyType { 56 | unsafe { MyType(value.int32_val()) } 57 | } 58 | } 59 | ``` 60 | 61 | This can also be accomplished using the derive macros: 62 | 63 | ```rust 64 | # extern crate ocaml; 65 | 66 | #[derive(ocaml::ToValue, ocaml::FromValue)] 67 | pub struct MyType(i32); 68 | ``` 69 | 70 | `derive(ToValue, FromValue)` will work on any struct or enum that are comprised of types that also implement `ToValue` and `FromValue` 71 | 72 | ## Types that work directly on OCaml values 73 | 74 | There are several types that work directly on OCaml values, these don't perform any copies when converting to and from `Value`. 75 | 76 | | Rust type | OCaml type 77 | | ------------------------------ | -------------------------------------- | 78 | | `ocaml::Array` | `'a array` | 79 | | `ocaml::List` | `'a list` | 80 | | `ocaml::Seq` | `'a Seq.t` | 81 | | `ocaml::bigarray::Array1` | `('a, 'b, c_layout) Bigarray.Array1.t` | 82 | | `ocaml::bigarray::Array2` | `('a, 'b, c_layout) Bigarray.Array2.t` | 83 | | `ocaml::bigarray::Array3` | `('a, 'b, c_layout) Bigarray.Array3.t` | 84 | 85 | ## Wrapping Rust values 86 | 87 | Rust values can be used as opaque values that can be shared with OCaml using [ocaml::Pointer](https://docs.rs/ocaml/latest/ocaml/struct.Pointer.html). The `Pointer` type allows for Rust values to be allocated using the OCaml runtime, this means their lifetime will be handled by the garbage collector. [Pointer::alloc_final](https://docs.rs/ocaml/latest/ocaml/struct.Pointer.html#method.alloc_final) is used to move an existing Rust type into an OCaml allocated pointer, but even better is the option to implement the `Custom` trait for your type. 88 | 89 | Implementing [Custom](https://docs.rs/ocaml/latest/ocaml/custom/trait.Custom.html) allows you to define equality/comparison, finalization, hashing and serialization functions for your type that will be used by OCaml. When allocating custom values you should use `Pointer::from` or `Pointer::alloc_custom`. 90 | 91 | In either case you will need to write the allocation function in Rust because OCaml doesn't know the specifics about the layout or contents of these types, unlike when using `FromValue` or `ToValue`. [Pointer](https://docs.rs/ocaml/latest/ocaml/struct.Pointer.html) should primarily be used on Rust values that cannot be converted directly to OCaml types. 92 | 93 | ```rust 94 | # extern crate ocaml; 95 | 96 | #[ocaml::sig] // Creates an opaque type on the OCaml side 97 | pub struct MyType { 98 | a: i32, 99 | b: f64, 100 | c: std::fs::File, // This can't be converted to an OCaml value 101 | } 102 | 103 | ocaml::custom!(MyType); 104 | 105 | #[ocaml::func] 106 | #[ocaml::sig("my_type -> float")] 107 | pub unsafe fn my_type_add_a_b(t: &MyType) -> f64 { 108 | t.a as f64 + t.b 109 | } 110 | ``` 111 | NOTE: In this example the Rust type `MyType` has automatically been renamed to `my_type` in OCaml. 112 | 113 | Also in this example, the default finalizer is used - this will call `Pointer::drop_in_place` to call `drop` on the Rust side before freeing the memory on the OCaml heap. If you add your own `finalize` implementation you should make sure to call `Pointer::drop_in_place` any time the underlying Rust value contains dynamically allocated values, like `std::fs::File` in the example above. 114 | 115 | Now that you have some insight into how type conversion is handled, the next section will cover more details about writing OCaml functions in Rust. 116 | -------------------------------------------------------------------------------- /doc/src/03_writing_ocaml_functions_in_rust.md: -------------------------------------------------------------------------------- 1 | # Writing OCaml functions in Rust 2 | 3 | This section requires the `derive` feature, which is enabled in `ocaml-rs` by default. This exposes [ocaml::func](https://docs.rs/ocaml/latest/ocaml/attr.func.html), which is the recommended way to create an OCaml function in Rust. Below are some examples using `ocaml::func` 4 | 5 | - [Hello world](#hello-world) 6 | - [Structs and enums](#structs-and-enums) 7 | - [Calling an OCaml function](#calling-an-ocaml-function) 8 | - [Opaque types](#opaque-types) 9 | - [Raising an exception](#raising-an-exception) 10 | - [Returning OCaml result](#returning-ocaml-resut) 11 | - [Using `Value` directly](#using-value-directly) 12 | - [Unboxed arguments](#unboxed-arguments) 13 | 14 | ## Hello world 15 | 16 | This example returns a string from Rust to OCaml 17 | 18 | ```rust 19 | # extern crate ocaml; 20 | #[ocaml::func] 21 | #[ocaml::sig("unit -> string")] 22 | pub fn hello_world() -> &'static str { 23 | "Hello, world!" 24 | } 25 | ``` 26 | 27 | ## Structs and enums 28 | 29 | The example uses `derive(ToValue)` and `derive(FromValue)` to create an enum and struct that can be used as parameters to `ocaml::func`s. Their names will be converted to snake case for OCaml, so the Rust type `BinOp` will become `bin_op` and `Expr` will become `expr`. 30 | 31 | ```rust 32 | # extern crate ocaml; 33 | 34 | #[derive(ocaml::FromValue, ocaml::ToValue, Clone, Copy)] 35 | #[ocaml::sig("Add | Sub | Mul | Div")] 36 | pub enum BinOp { 37 | Add, 38 | Sub, 39 | Mul, 40 | Div 41 | } 42 | 43 | #[derive(ocaml::FromValue, ocaml::ToValue)] 44 | #[ocaml::sig("lhs: float; rhs: float; op: bin_op")] 45 | pub struct Expr { 46 | lhs: f64, 47 | rhs: f64, 48 | op: BinOp, 49 | } 50 | 51 | #[ocaml::func] 52 | #[ocaml::sig("expr -> float")] 53 | pub fn expr_eval(expr: Expr) -> f64 { 54 | match expr.op { 55 | BinOp::Add => expr.lhs + expr.rhs, 56 | BinOp::Sub => expr.lhs - expr.rhs, 57 | BinOp::Mul => expr.lhs * expr.rhs, 58 | BinOp::Div => expr.lhs / expr.rhs 59 | } 60 | } 61 | 62 | ``` 63 | 64 | ## Calling an OCaml function 65 | 66 | This example shows how to call an OCaml function from Rust - the OCaml function must be registered using [Callback.register](https://ocaml.org/api/Callback.html). In this case we're calling the OCaml function `my_incr`, which looks like this: 67 | 68 | ```ocaml 69 | let my_incr x = x + 1 70 | let () = Callback.register "my_incr" my_incr 71 | ``` 72 | 73 | ```rust 74 | # extern crate ocaml; 75 | 76 | ocaml::import! { 77 | fn my_incr(x: ocaml::Int) -> ocaml::Int; 78 | } 79 | 80 | #[ocaml::func] 81 | #[ocaml::sig("int -> int")] 82 | pub unsafe fn call_my_incr(x: ocaml::Int) -> Result { 83 | my_incr(gc, x) 84 | } 85 | ``` 86 | 87 | A few things to note: 88 | 89 | - When calling the [import!](https://docs.rs/ocaml/latest/ocaml/macro.import.html)ed function you will need to pass the OCaml runtime handle as the first parameter 90 | - The return value of the function will be wrapped in `Result` because the function may raise an exception 91 | 92 | For functions that aren't registered using `Callback.register` you can use the `ocaml::function!` macro to convert them into a typed closure: 93 | 94 | ```rust 95 | # extern crate ocaml; 96 | 97 | #[ocaml::func] 98 | #[ocaml::sig("(int -> int) -> int -> int")] 99 | pub unsafe fn call_incr(incr: ocaml::Value, a: ocaml::Int) -> Result { 100 | let incr = ocaml::function!(incr, (a: ocaml::Int) -> ocaml::Int); 101 | incr(gc, &a) 102 | } 103 | ``` 104 | 105 | ## Opaque types 106 | 107 | This example shows how to wrap a Rust type using the [Custom](https://docs.rs/ocaml/latest/ocaml/custom/trait.Custom.html) trait and [ocaml::Pointer](https://docs.rs/ocaml/latest/ocaml/struct.Pointer.html) 108 | 109 | ```rust 110 | # extern crate ocaml; 111 | 112 | use std::io::Read; 113 | 114 | #[ocaml::sig] // Creates an opaque type on the OCaml side 115 | struct File(std::fs::File); 116 | 117 | ocaml::custom!(File); 118 | 119 | #[ocaml::func] 120 | #[ocaml::sig("string -> file")] 121 | pub fn file_open(filename: &str) -> Result, ocaml::Error> { 122 | let f = std::fs::File::open(filename)?; 123 | Ok(File(f).into()) 124 | } 125 | 126 | #[ocaml::func] 127 | #[ocaml::sig("file -> string")] 128 | pub fn file_read(file : &mut File) -> Result { 129 | let mut s = String::new(); 130 | file.0.read_to_string(&mut s)?; 131 | Ok(s) 132 | } 133 | ``` 134 | 135 | Once this value is garbage collected, the default finalizer will call `Pointer::drop_in_place` to run `drop` and clean up resources on the Rust side, if you write a custom finalizer make sure to include a call to `Pointer::drop_in_place`. 136 | 137 | ## Raising an exception 138 | 139 | Raising an exception is accomplished by panicking: 140 | 141 | 142 | ```rust 143 | # extern crate ocaml; 144 | 145 | #[ocaml::func] 146 | #[ocaml::sig("int -> unit")] 147 | pub unsafe fn fail_if_even_panic(i: ocaml::Int) { 148 | if i % 2 == 0 { 149 | panic!("even") 150 | } 151 | } 152 | ``` 153 | 154 | or returning a `Result<_, ocaml::Error>` value: 155 | 156 | 157 | ```rust 158 | # extern crate ocaml; 159 | 160 | #[ocaml::func] 161 | #[ocaml::sig("int -> unit")] 162 | pub unsafe fn fail_if_even_result(i: ocaml::Int) -> Result<(), ocaml::Error> { 163 | if i % 2 == 0 { 164 | return Err(ocaml::CamlError::Failure("even").into()) 165 | } 166 | 167 | Ok(()) 168 | } 169 | ``` 170 | 171 | ## Returning OCaml result 172 | 173 | In the previous example `Result<_, ocaml::Error>` was used to raise an exception, however `Result` where `A` and `B` both implement `ToValue` will create an OCaml `('a, 'b) Result.t`: 174 | 175 | ```rust 176 | # extern crate ocaml; 177 | use ocaml::{ToValue}; 178 | 179 | #[ocaml::func] 180 | #[ocaml::sig("string -> (int, [`Msg of string]) result")] 181 | pub unsafe fn try_int_of_string(s: &str) -> Result { 182 | match s.parse::() { 183 | Ok(i) => Ok(i), 184 | Err(e) => { 185 | let s = format!("{e:?}"); 186 | let err = ocaml::Value::hash_variant(gc, "Msg", Some(s.to_value(gc))); 187 | Err(err) 188 | } 189 | } 190 | } 191 | ``` 192 | 193 | ## Using `Value` directly 194 | 195 | It is also possible to use `ocaml::Value` to avoid any conversion or copying, however this can be more error prone. 196 | 197 | ```rust 198 | # extern crate ocaml; 199 | 200 | #[ocaml::func] 201 | #[ocaml::sig("string array -> int -> string -> unit")] 202 | pub unsafe fn array_set(mut array: ocaml::Value, index: ocaml::Value, s: ocaml::Value) { 203 | array.store_field(gc, index.int_val() as usize, s) 204 | } 205 | ``` 206 | 207 | ## Unboxed arguments 208 | 209 | Unfortunately `ocaml::func` doesn't support unboxed/noalloc functions, however it is still possible to create them using `ocaml-rs`: 210 | 211 | ```rust 212 | # extern crate ocaml; 213 | 214 | #[no_mangle] 215 | pub extern "C" fn unboxed_float_avg(a: f64, b: f64) -> f64 { 216 | (a + b) / 2.0 217 | } 218 | 219 | #[ocaml::bytecode_func] 220 | pub fn unboxed_float_avg_bytecode(a: f64, b: f64) -> f64 { 221 | unboxed_float_avg(a, b) 222 | } 223 | ``` 224 | 225 | In this case you will also need to write the signature manually: 226 | 227 | ```ocaml 228 | external unboxed_float_avg: float -> float -> float = "unboxed_float_avg_bytecode" "unboxed_float_avg" [@@unboxed] [@@noalloc] 229 | ``` 230 | -------------------------------------------------------------------------------- /doc/src/04_linking_an_ocaml_library_into_a_rust_program.md: -------------------------------------------------------------------------------- 1 | # Linking an OCaml library into a Rust program 2 | 3 | The section will cover how to create a program in Rust that calls functions from an OCaml library. 4 | 5 | Example project layout: 6 | 7 | - Cargo.toml 8 | - build.rs 9 | - `src`: contains Rust code 10 | - `lib`: contains OCaml code and `dune` file 11 | - `dune-project` 12 | - `example.opam` 13 | 14 | Add the following to your `Cargo.toml`: 15 | 16 | ```toml 17 | [dependencies] 18 | ocaml = "*" 19 | 20 | [build-dependencies] 21 | ocaml-build = {version = "*", features=["dune"]} 22 | ``` 23 | 24 | And add a `build.rs`, this example assumes your OCaml library and the following `dune` file are in `lib` at the root of your Rust project: 25 | 26 | ```rust,ignore 27 | # extern crate ocaml_build; 28 | pub fn main() { 29 | ocaml_build::Dune::new("lib").build() 30 | } 31 | ``` 32 | 33 | If the `dune` root is not the root of your project you can use `Dune::with_root` to set the correct path. 34 | 35 | Next you will need to add setup a [dune](https://dune.build) project to handle compilation of your OCaml code. Here is an example `dune` file that will generate object files that can be linked into your Rust program, in this case the OCaml library is named `example`: 36 | 37 | ```ignore 38 | (executable 39 | (name example) 40 | (public_name example) 41 | (modes exe object)) 42 | ``` 43 | 44 | NOTE: The OCaml code needs to be built with dune in `object` mode 45 | 46 | In `lib/example.ml` 47 | 48 | ```ocaml 49 | let hello_world () = "Hello, world" 50 | let () = Callback.register "hello_world" hello_world 51 | ``` 52 | 53 | In `lib/main.rs`: 54 | 55 | ```rust,ignore 56 | # extern crate ocaml; 57 | 58 | ocaml::import! { 59 | fn hello_world() -> String; 60 | } 61 | 62 | pub fn main() { 63 | let gc = ocaml::init(); // Initialize OCaml runtime 64 | 65 | let s = unsafe { hello_world(&gc).unwrap() }; 66 | println!("{s}"); 67 | } 68 | ``` 69 | 70 | NOTE: [ocaml::init](https://docs.rs/ocaml/latest/ocaml/runtime/fn.init.html) needs to be called before attempting to access any OCaml functions. 71 | 72 | To simplify the full setup process, take a look at [rust-ocaml-starter](https://github.com/zshipko/rust-ocaml-starter). 73 | 74 | -------------------------------------------------------------------------------- /doc/src/SUMMARY.md: -------------------------------------------------------------------------------- 1 | # Summary 2 | 3 | - [Introduction](./01_introduction.md) 4 | - [Type conversion](./02_type_conversion.md) 5 | - [Writing OCaml functions in Rust](./03_writing_ocaml_functions_in_rust.md) 6 | - [Linking an OCaml library into a Rust program](./04_linking_an_ocaml_library_into_a_rust_program.md) 7 | -------------------------------------------------------------------------------- /examples/rust.rs: -------------------------------------------------------------------------------- 1 | use ocaml::{Error, FromValue, ToValue, Value}; 2 | 3 | fn test_basic_array() -> Result<(), Error> { 4 | ocaml::runtime::init(); 5 | let gc = unsafe { ocaml::Runtime::recover_handle() }; 6 | unsafe { 7 | let mut a: ocaml::Array<&str> = ocaml::Array::alloc(2); 8 | a.set(gc, 0, &"testing")?; 9 | a.set(gc, 1, &"123")?; 10 | let b: Vec<&str> = FromValue::from_value(a.to_value(gc)); 11 | assert!(b.as_slice() == &["testing", "123"]); 12 | Ok(()) 13 | } 14 | } 15 | 16 | fn test_basic_list() { 17 | ocaml::runtime::init(); 18 | let gc = unsafe { ocaml::Runtime::recover_handle() }; 19 | let mut list = ocaml::List::empty(); 20 | let a = 3i64.to_value(gc); 21 | let b = 2i64.to_value(gc); 22 | let c = 1i64.to_value(gc); 23 | 24 | unsafe { 25 | list = list.add(gc, &a); 26 | list = list.add(gc, &b); 27 | list = list.add(gc, &c); 28 | } 29 | 30 | unsafe { 31 | assert!(list.len() == 3); 32 | } 33 | 34 | let ll: std::collections::LinkedList = FromValue::from_value(list.to_value(gc)); 35 | 36 | for (i, x) in ll.into_iter().enumerate() { 37 | assert!((i + 1) as i64 == x); 38 | } 39 | } 40 | 41 | fn test_int() { 42 | ocaml::runtime::init_persistent(); 43 | let gc = unsafe { ocaml::Runtime::recover_handle() }; 44 | let a = (-123isize).to_value(gc); 45 | let b = (-1isize).to_value(gc); 46 | let c = 123isize.to_value(gc); 47 | let d = 1isize.to_value(gc); 48 | let e = 0isize.to_value(gc); 49 | 50 | let a_: isize = FromValue::from_value(a); 51 | let b_: isize = FromValue::from_value(b); 52 | let c_: isize = FromValue::from_value(c); 53 | let d_: isize = FromValue::from_value(d); 54 | let e_: isize = FromValue::from_value(e); 55 | assert_eq!(a_, -123); 56 | assert_eq!(b_, -1); 57 | assert_eq!(c_, 123); 58 | assert_eq!(d_, 1); 59 | assert_eq!(e_, 0); 60 | } 61 | 62 | #[ocaml::func] 63 | pub fn make_tuple(a: Value, b: Value) -> (Value, Value) { 64 | (a, b) 65 | } 66 | 67 | fn test_tuple_of_tuples() { 68 | ocaml::runtime::init_persistent(); 69 | let gc = unsafe { ocaml::Runtime::recover_handle() }; 70 | 71 | let x = (1f64, 2f64, 3f64, 4f64, 5f64, 6f64, 7f64, 8f64, 9f64).to_value(gc); 72 | let y = (9f64, 8f64, 7f64, 6f64, 5f64, 4f64, 3f64, 2f64, 1f64).to_value(gc); 73 | let ((a, b, c, d, e, f, g, h, i), (j, k, l, m, n, o, p, q, r)): ( 74 | (f64, f64, f64, f64, f64, f64, f64, f64, f64), 75 | (f64, f64, f64, f64, f64, f64, f64, f64, f64), 76 | ) = unsafe { FromValue::from_value(Value::new(make_tuple(x.raw(), y.raw()))) }; 77 | 78 | println!("a: {}, r: {}", a, r); 79 | assert!(a == r); 80 | assert!(b == q); 81 | assert!(c == p); 82 | assert!(d == o); 83 | assert!(e == n); 84 | assert!(f == m); 85 | assert!(g == l); 86 | assert!(h == k); 87 | assert!(i == j); 88 | } 89 | 90 | fn main() { 91 | test_basic_array().unwrap(); 92 | test_basic_list(); 93 | test_int(); 94 | test_tuple_of_tuples(); 95 | } 96 | -------------------------------------------------------------------------------- /src/conv.rs: -------------------------------------------------------------------------------- 1 | use core::convert::TryInto; 2 | 3 | use crate::{ 4 | sys, 5 | value::{FromValue, ToValue, Value}, 6 | Raw, Runtime, Tag, 7 | }; 8 | 9 | unsafe impl ToValue for &T { 10 | fn to_value(&self, rt: &Runtime) -> Value { 11 | ToValue::to_value(*self, rt) 12 | } 13 | } 14 | 15 | macro_rules! value_i { 16 | ($t:ty) => { 17 | unsafe impl ToValue for $t { 18 | fn to_value(&self, _rt: &Runtime) -> $crate::Value { 19 | unsafe { $crate::Value::int(*self as crate::Int) } 20 | } 21 | } 22 | 23 | unsafe impl FromValue for $t { 24 | fn from_value(v: $crate::Value) -> $t { 25 | unsafe { v.int_val() as $t } 26 | } 27 | } 28 | }; 29 | ($($t:ty),*) => { 30 | $(value_i!($t);)* 31 | } 32 | } 33 | 34 | macro_rules! value_f { 35 | ($t:ty) => { 36 | unsafe impl ToValue for $t { 37 | fn to_value(&self, _rt: &Runtime) -> $crate::Value { 38 | unsafe { $crate::Value::double(*self as crate::Float) } 39 | } 40 | } 41 | 42 | unsafe impl FromValue for $t { 43 | fn from_value(v: $crate::Value) -> $t { 44 | unsafe { v.double_val () as $t } 45 | } 46 | } 47 | }; 48 | ($($t:ty),*) => { 49 | $(value_f!($t);)* 50 | } 51 | } 52 | 53 | value_i!(i8, u8, i16, u16, crate::Int, crate::Uint); 54 | value_f!(f32, f64); 55 | 56 | unsafe impl ToValue for i64 { 57 | fn to_value(&self, _rt: &Runtime) -> crate::Value { 58 | unsafe { Value::int64(*self) } 59 | } 60 | } 61 | 62 | unsafe impl FromValue for i64 { 63 | fn from_value(v: Value) -> i64 { 64 | unsafe { v.int64_val() } 65 | } 66 | } 67 | 68 | unsafe impl ToValue for u64 { 69 | fn to_value(&self, _rt: &Runtime) -> crate::Value { 70 | unsafe { Value::int64(*self as i64) } 71 | } 72 | } 73 | 74 | unsafe impl FromValue for u64 { 75 | fn from_value(v: Value) -> u64 { 76 | unsafe { v.int64_val() as u64 } 77 | } 78 | } 79 | 80 | unsafe impl ToValue for i32 { 81 | fn to_value(&self, _rt: &Runtime) -> crate::Value { 82 | unsafe { Value::int32(*self) } 83 | } 84 | } 85 | 86 | unsafe impl FromValue for i32 { 87 | fn from_value(v: Value) -> i32 { 88 | unsafe { v.int32_val() } 89 | } 90 | } 91 | 92 | unsafe impl ToValue for u32 { 93 | fn to_value(&self, _rt: &Runtime) -> crate::Value { 94 | unsafe { Value::int32(*self as i32) } 95 | } 96 | } 97 | 98 | unsafe impl FromValue for u32 { 99 | fn from_value(v: Value) -> u32 { 100 | unsafe { v.int32_val() as u32 } 101 | } 102 | } 103 | 104 | struct Incr(usize); 105 | 106 | impl Incr { 107 | fn get(&mut self) -> usize { 108 | let i = self.0; 109 | self.0 = i + 1; 110 | i 111 | } 112 | } 113 | 114 | macro_rules! tuple_impl { 115 | ($($t:ident: $n:tt),*) => { 116 | unsafe impl<$($t: FromValue),*> FromValue for ($($t,)*) { 117 | fn from_value(v: Value) -> ($($t,)*) { 118 | let mut i = Incr(0); 119 | #[allow(unused)] 120 | ( 121 | $( 122 | $t::from_value(unsafe { v.field(i.get()) }), 123 | )* 124 | ) 125 | } 126 | } 127 | 128 | unsafe impl<$($t: ToValue),*> ToValue for ($($t,)*) { 129 | fn to_value(&self, rt: &Runtime) -> crate::Value { 130 | #[allow(unused)] 131 | let mut len = 0; 132 | $( 133 | #[allow(unused)] 134 | { 135 | len = $n + 1; 136 | } 137 | )* 138 | 139 | unsafe { 140 | let mut v = $crate::Value::alloc(len, Tag(0)); 141 | $( 142 | v.store_field(rt, $n, &self.$n); 143 | )* 144 | 145 | v 146 | } 147 | } 148 | } 149 | }; 150 | } 151 | 152 | tuple_impl!(A: 0); 153 | tuple_impl!(A: 0, B: 1); 154 | tuple_impl!(A: 0, B: 1, C: 2); 155 | tuple_impl!(A: 0, B: 1, C: 2, D: 3); 156 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4); 157 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5); 158 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6); 159 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7); 160 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8); 161 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9); 162 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10); 163 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11); 164 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12); 165 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13); 166 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14); 167 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14, P: 15); 168 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14, P: 15, Q: 16); 169 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14, P: 15, Q: 16, R: 17); 170 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14, P: 15, Q: 16, R: 17, S: 18); 171 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14, P: 15, Q: 16, R: 17, S: 18, T: 19); 172 | tuple_impl!(A: 0, B: 1, C: 2, D: 3, E: 4, F: 5, G: 6, H: 7, I: 8, J: 9, K: 10, L: 11, M: 12, N: 13, O: 14, P: 15, Q: 16, R: 17, S: 18, T: 19, U: 20); 173 | 174 | unsafe impl ToValue for bool { 175 | fn to_value(&self, _rt: &Runtime) -> Value { 176 | unsafe { Value::int(*self as isize) } 177 | } 178 | } 179 | 180 | unsafe impl FromValue for bool { 181 | fn from_value(v: Value) -> bool { 182 | unsafe { v.int_val() != 0 } 183 | } 184 | } 185 | 186 | #[cfg(not(feature = "no-std"))] 187 | unsafe impl ToValue for String { 188 | fn to_value(&self, _rt: &Runtime) -> Value { 189 | unsafe { Value::string(self.as_str()) } 190 | } 191 | } 192 | 193 | #[cfg(not(feature = "no-std"))] 194 | unsafe impl FromValue for String { 195 | fn from_value(value: Value) -> String { 196 | unsafe { value.string_val().into() } 197 | } 198 | } 199 | 200 | unsafe impl ToValue for () { 201 | fn to_value(&self, _rt: &Runtime) -> Value { 202 | Value::unit() 203 | } 204 | } 205 | 206 | unsafe impl FromValue for () { 207 | fn from_value(_value: Value) {} 208 | } 209 | 210 | unsafe impl FromValue for Option { 211 | fn from_value(value: Value) -> Option { 212 | if value.raw().0 == sys::NONE { 213 | return None; 214 | } 215 | 216 | unsafe { Some(T::from_value(value.field(0))) } 217 | } 218 | } 219 | 220 | unsafe impl ToValue for Option { 221 | fn to_value(&self, rt: &Runtime) -> Value { 222 | match self { 223 | Some(y) => unsafe { Value::some(rt, y) }, 224 | None => Value::none(), 225 | } 226 | } 227 | } 228 | 229 | unsafe impl<'a> FromValue for &'a str { 230 | fn from_value(value: Value) -> &'a str { 231 | unsafe { 232 | let len = sys::caml_string_length(value.raw().0); 233 | let ptr = sys::string_val(value.raw().0); 234 | let slice = ::core::slice::from_raw_parts(ptr, len); 235 | ::core::str::from_utf8(slice).expect("Invalid UTF-8") 236 | } 237 | } 238 | } 239 | 240 | unsafe impl ToValue for &str { 241 | fn to_value(&self, _rt: &Runtime) -> Value { 242 | unsafe { Value::string(self) } 243 | } 244 | } 245 | 246 | unsafe impl<'a> FromValue for &'a mut str { 247 | fn from_value(value: Value) -> &'a mut str { 248 | unsafe { 249 | let len = sys::caml_string_length(value.raw().0); 250 | let ptr = sys::string_val(value.raw().0); 251 | let slice = ::core::slice::from_raw_parts_mut(ptr, len); 252 | ::core::str::from_utf8_mut(slice).expect("Invalid UTF-8") 253 | } 254 | } 255 | } 256 | 257 | unsafe impl ToValue for &mut str { 258 | fn to_value(&self, _rt: &Runtime) -> Value { 259 | unsafe { Value::string(self) } 260 | } 261 | } 262 | 263 | unsafe impl<'a> FromValue for &'a [u8] { 264 | fn from_value(value: Value) -> &'a [u8] { 265 | unsafe { 266 | let len = sys::caml_string_length(value.raw().0); 267 | let ptr = sys::string_val(value.raw().0); 268 | ::core::slice::from_raw_parts(ptr, len) 269 | } 270 | } 271 | } 272 | 273 | unsafe impl ToValue for &[u8] { 274 | fn to_value(&self, _rt: &Runtime) -> Value { 275 | unsafe { Value::bytes(self) } 276 | } 277 | } 278 | 279 | unsafe impl<'a> FromValue for &'a mut [u8] { 280 | fn from_value(value: Value) -> &'a mut [u8] { 281 | unsafe { 282 | let len = sys::caml_string_length(value.raw().0); 283 | let ptr = sys::string_val(value.raw().0); 284 | ::core::slice::from_raw_parts_mut(ptr, len) 285 | } 286 | } 287 | } 288 | 289 | unsafe impl ToValue for &mut [u8] { 290 | fn to_value(&self, _rt: &Runtime) -> Value { 291 | unsafe { Value::bytes(self) } 292 | } 293 | } 294 | 295 | unsafe impl FromValue for [u8; N] { 296 | fn from_value(value: Value) -> Self { 297 | unsafe { 298 | let len = sys::caml_string_length(value.raw().0); 299 | assert!(len == N); 300 | let ptr = sys::string_val(value.raw().0); 301 | ::core::slice::from_raw_parts(ptr, len).try_into().unwrap() 302 | } 303 | } 304 | } 305 | 306 | unsafe impl ToValue for [u8; N] { 307 | fn to_value(&self, _rt: &Runtime) -> Value { 308 | unsafe { Value::bytes(self) } 309 | } 310 | } 311 | 312 | #[cfg(not(feature = "no-std"))] 313 | unsafe impl FromValue for Box { 314 | fn from_value(v: Value) -> Box { 315 | Box::new(V::from_value(v)) 316 | } 317 | } 318 | 319 | #[cfg(not(feature = "no-std"))] 320 | unsafe impl ToValue for Box { 321 | fn to_value(&self, rt: &Runtime) -> Value { 322 | (**self).to_value(rt) 323 | } 324 | } 325 | 326 | #[cfg(not(feature = "no-std"))] 327 | unsafe impl ToValue for Vec { 328 | fn to_value(&self, rt: &Runtime) -> Value { 329 | let len = self.len(); 330 | 331 | if (core::any::TypeId::of::() == core::any::TypeId::of::() 332 | || core::any::TypeId::of::() == core::any::TypeId::of::()) 333 | && sys::FLAT_FLOAT_ARRAY 334 | { 335 | let mut arr = unsafe { Value::alloc_double_array(len) }; 336 | for (i, v) in self.iter().enumerate() { 337 | unsafe { 338 | arr.store_double_field(i, v.to_value(rt).double_val()); 339 | } 340 | } 341 | arr 342 | } else { 343 | let mut arr = unsafe { Value::alloc(len, 0.into()) }; 344 | for (i, v) in self.iter().enumerate() { 345 | unsafe { 346 | arr.store_field(rt, i, v); 347 | } 348 | } 349 | arr 350 | } 351 | } 352 | } 353 | 354 | #[cfg(not(feature = "no-std"))] 355 | unsafe impl FromValue for Vec { 356 | fn from_value(v: Value) -> Vec { 357 | unsafe { 358 | let len = crate::sys::caml_array_length(v.raw().0); 359 | let is_double = sys::caml_is_double_array(v.raw().0) == 1 && sys::FLAT_FLOAT_ARRAY; 360 | let mut dst = Vec::with_capacity(len); 361 | if is_double { 362 | let mut tmp = Value::double(0.0); 363 | for i in 0..len { 364 | tmp.store_double_val(v.double_field(i)); 365 | dst.push(V::from_value(Value::new(tmp.raw().0))); 366 | } 367 | } else { 368 | for i in 0..len { 369 | dst.push(V::from_value(Value::new(*crate::sys::field(v.raw().0, i)))) 370 | } 371 | } 372 | dst 373 | } 374 | } 375 | } 376 | 377 | unsafe impl<'a> FromValue for &'a [Raw] { 378 | fn from_value(value: Value) -> &'a [Raw] { 379 | unsafe { 380 | ::core::slice::from_raw_parts( 381 | crate::sys::field(value.raw().0, 0) as *mut Raw, 382 | crate::sys::wosize_val(value.raw().0), 383 | ) 384 | } 385 | } 386 | } 387 | 388 | unsafe impl<'a> FromValue for &'a mut [Raw] { 389 | fn from_value(value: Value) -> &'a mut [Raw] { 390 | unsafe { 391 | ::core::slice::from_raw_parts_mut( 392 | crate::sys::field(value.raw().0, 0) as *mut Raw, 393 | crate::sys::wosize_val(value.raw().0), 394 | ) 395 | } 396 | } 397 | } 398 | 399 | #[cfg(not(feature = "no-std"))] 400 | unsafe impl FromValue for std::collections::BTreeMap { 401 | fn from_value(v: Value) -> std::collections::BTreeMap { 402 | let mut dest = std::collections::BTreeMap::new(); 403 | unsafe { 404 | let mut tmp = v; 405 | while tmp.raw().0 != crate::sys::EMPTY_LIST { 406 | let (k, v) = FromValue::from_value(tmp.field(0)); 407 | dest.insert(k, v); 408 | tmp = tmp.field(1); 409 | } 410 | } 411 | 412 | dest 413 | } 414 | } 415 | 416 | #[cfg(not(feature = "no-std"))] 417 | unsafe impl ToValue for std::collections::BTreeMap { 418 | fn to_value(&self, rt: &Runtime) -> Value { 419 | let mut list = crate::List::empty(); 420 | 421 | for (k, v) in self.iter().rev() { 422 | let k_ = k.to_value(rt); 423 | let v_ = v.to_value(rt); 424 | list = unsafe { list.add(rt, &(k_, v_)) }; 425 | } 426 | 427 | list.to_value(rt) 428 | } 429 | } 430 | 431 | #[cfg(not(feature = "no-std"))] 432 | unsafe impl FromValue for std::collections::LinkedList { 433 | fn from_value(v: Value) -> std::collections::LinkedList { 434 | let mut dest: std::collections::LinkedList = std::collections::LinkedList::new(); 435 | 436 | unsafe { 437 | let mut tmp = v; 438 | while tmp.raw().0 != crate::sys::EMPTY_LIST { 439 | let t = T::from_value(tmp.field(0)); 440 | dest.push_back(t); 441 | tmp = tmp.field(1); 442 | } 443 | } 444 | 445 | dest 446 | } 447 | } 448 | 449 | #[cfg(not(feature = "no-std"))] 450 | unsafe impl ToValue for std::collections::LinkedList { 451 | fn to_value(&self, rt: &Runtime) -> Value { 452 | let mut list = crate::List::empty(); 453 | 454 | for v in self.iter().rev() { 455 | let v_ = v.to_value(rt); 456 | list = unsafe { list.add(rt, &v_) }; 457 | } 458 | 459 | list.to_value(rt) 460 | } 461 | } 462 | -------------------------------------------------------------------------------- /src/custom.rs: -------------------------------------------------------------------------------- 1 | use crate::*; 2 | 3 | /// CustomOps duplicates `sys::custom::custom_operations` to provide a slightly nicer experience in 4 | /// Rust 5 | /// 6 | /// This should rarely be constructed manually, `custom!` simplifies the process of creating custom 7 | /// types. 8 | /// 9 | /// See [the struct 10 | /// custom_operations](https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html#ss:c-custom-ops) 11 | /// section in the OCaml manual for more information about each field 12 | #[derive(Clone)] 13 | #[repr(C)] 14 | #[allow(missing_docs)] 15 | pub struct CustomOps { 16 | pub identifier: *const ocaml_sys::Char, 17 | pub finalize: Option, 18 | pub compare: Option i32>, 19 | pub hash: Option Int>, 20 | 21 | pub serialize: Option, 22 | pub deserialize: Option Uint>, 23 | pub compare_ext: Option i32>, 24 | pub fixed_length: *const sys::custom_fixed_length, 25 | } 26 | 27 | impl Default for CustomOps { 28 | fn default() -> CustomOps { 29 | DEFAULT_CUSTOM_OPS 30 | } 31 | } 32 | 33 | /// `Custom` is used to define OCaml types that wrap existing Rust types, but are owned by the 34 | /// garbage collector 35 | /// 36 | /// A custom type can only be converted to a `Value` using `ToValue`, but can't be converted from a 37 | /// value. Once the Rust value is owned by OCaml it should be accessed using `ocaml::Pointer` to 38 | /// avoid reallocating the same value. By default the inner Rust value will be dropped when the 39 | /// finalizer runs on the OCaml side. 40 | /// 41 | /// ```rust 42 | /// struct Example(ocaml::Int); 43 | /// 44 | /// ocaml::custom! (Example); 45 | /// 46 | /// #[cfg(feature = "derive")] 47 | /// #[ocaml::func] 48 | /// pub unsafe fn example() -> ocaml::Pointer { 49 | /// Example(123).into() 50 | /// } 51 | /// 52 | /// #[cfg(feature = "derive")] 53 | /// #[ocaml::func] 54 | /// pub unsafe fn example_value(x: &Example) -> ocaml::Int { 55 | /// x.0 56 | /// } 57 | /// ``` 58 | pub trait Custom: Sized { 59 | /// Custom type name 60 | const NAME: &'static str; 61 | 62 | /// Custom type fixed length 63 | const FIXED_LENGTH: Option = None; 64 | 65 | /// Custom operations 66 | const OPS: CustomOps; 67 | 68 | /// `used` parameter to `alloc_custom`. This helps determine the frequency of garbage 69 | /// collection related to this custom type. 70 | const USED: usize = 0; 71 | 72 | /// `max` parameter to `alloc_custom`. This helps determine the frequency of garbage collection 73 | /// related to this custom type 74 | const MAX: usize = 1; 75 | 76 | /// Automatically calls `Pointer::drop_in_place` 77 | unsafe extern "C" fn finalize(v: Raw) { 78 | let p = v.as_pointer::(); 79 | p.drop_in_place(); 80 | } 81 | 82 | /// Get a static reference the this type's `CustomOps` implementation 83 | fn ops() -> &'static CustomOps { 84 | &Self::OPS 85 | } 86 | } 87 | 88 | /// Create a custom OCaml type from an existing Rust type 89 | /// 90 | /// See [the struct 91 | /// custom_operations](https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html#ss:c-custom-ops) 92 | /// section in the OCaml manual for more information about each field 93 | /// 94 | /// ```rust 95 | /// struct MyType { 96 | /// s: String, 97 | /// i: i32, 98 | /// } 99 | /// 100 | /// unsafe extern "C" fn mytype_compare(a: ocaml::Raw, b: ocaml::Raw) -> i32 { 101 | /// let a = a.as_pointer::(); 102 | /// let b = b.as_pointer::(); 103 | /// 104 | /// let a_i = a.as_ref().i; 105 | /// let b_i = b.as_ref().i; 106 | /// 107 | /// if a_i == b_i { 108 | /// return 0 109 | /// } 110 | /// 111 | /// if a_i < b_i { 112 | /// return -1; 113 | /// } 114 | /// 115 | /// 1 116 | /// } 117 | /// 118 | /// ocaml::custom!(MyType { 119 | /// compare: mytype_compare, 120 | /// }); 121 | /// 122 | /// // This is equivalent to 123 | /// struct MyType2 { 124 | /// s: String, 125 | /// i: i32, 126 | /// } 127 | /// 128 | /// 129 | /// // This is the default finalizer 130 | /// unsafe extern "C" fn mytype2_finalizer(v: ocaml::Raw) { 131 | /// let ptr = v.as_pointer::(); 132 | /// ptr.drop_in_place(); 133 | /// } 134 | /// 135 | /// impl ocaml::Custom for MyType2 { 136 | /// const NAME: &'static str = "rust.MyType\0"; 137 | /// 138 | /// const OPS: ocaml::custom::CustomOps = ocaml::custom::CustomOps { 139 | /// identifier: Self::NAME.as_ptr() as *mut ocaml::sys::Char, 140 | /// finalize: Some(mytype2_finalizer), 141 | /// compare: Some(mytype_compare), 142 | /// .. ocaml::custom::DEFAULT_CUSTOM_OPS 143 | /// }; 144 | /// } 145 | /// ``` 146 | /// 147 | /// Additionally, `custom` can be used inside the `impl` block: 148 | /// 149 | /// ```rust 150 | /// extern "C" fn implexample_finalizer(_: ocaml::Raw) { 151 | /// println!("This runs when the value gets garbage collected"); 152 | /// } 153 | /// 154 | /// struct ImplExample<'a>(&'a str); 155 | /// 156 | /// impl<'a> ocaml::Custom for ImplExample<'a> { 157 | /// ocaml::custom! { 158 | /// name: "rust.ImplExample", 159 | /// finalize: implexample_finalizer 160 | /// } 161 | /// } 162 | /// 163 | /// // This is equivalent to: 164 | /// 165 | /// struct ImplExample2<'a>(&'a str); 166 | /// 167 | /// ocaml::custom!(ImplExample2<'a> { 168 | /// finalize: implexample_finalizer, 169 | /// }); 170 | /// ``` 171 | #[macro_export] 172 | macro_rules! custom { 173 | ($name:ident $(<$($t:tt),*>)? $({$($k:ident : $v:expr),* $(,)? })?) => { 174 | impl $(<$($t),*>)? $crate::Custom for $name $(<$($t),*>)? { 175 | $crate::custom! { 176 | name: concat!("rust.", stringify!($name)) 177 | $(, $($k: $v),*)? 178 | } 179 | } 180 | }; 181 | {name : $name:expr $(, fixed_length: $fl:expr)? $(, $($k:ident : $v:expr),*)? $(,)? } => { 182 | const NAME: &'static str = concat!($name, "\0"); 183 | 184 | const OPS: $crate::custom::CustomOps = $crate::custom::CustomOps { 185 | identifier: Self::NAME.as_ptr() as *const $crate::sys::Char, 186 | $($($k: Some($v),)*)? 187 | ..$crate::custom::CustomOps { 188 | finalize: Some(Self::finalize), 189 | .. $crate::custom::DEFAULT_CUSTOM_OPS 190 | } 191 | }; 192 | }; 193 | } 194 | 195 | unsafe impl FromValue for &T { 196 | fn from_value(v: Value) -> Self { 197 | let ptr = Pointer::from_value(v); 198 | unsafe { &*ptr.as_ptr() } 199 | } 200 | } 201 | 202 | unsafe impl FromValue for &mut T { 203 | fn from_value(v: Value) -> Self { 204 | let mut ptr = Pointer::from_value(v); 205 | unsafe { &mut *ptr.as_mut_ptr() } 206 | } 207 | } 208 | 209 | /// Derives `Custom` with the given finalizer for a type 210 | /// 211 | /// ```rust,no_run 212 | /// use ocaml::FromValue; 213 | /// 214 | /// struct MyType { 215 | /// name: String 216 | /// } 217 | /// 218 | /// // NOTE: this is the default finalizer, no need to write this in 219 | /// // your own code 220 | /// unsafe extern "C" fn mytype_finalizer(v: ocaml::Raw) { 221 | /// let p = v.as_pointer::(); 222 | /// p.drop_in_place(); 223 | /// } 224 | /// 225 | /// ocaml::custom_finalize!(MyType, mytype_finalizer); 226 | /// 227 | /// // Which is a shortcut for: 228 | /// 229 | /// struct MyType2 { 230 | /// name: String 231 | /// } 232 | /// 233 | /// unsafe extern "C" fn mytype2_finalizer(v: ocaml::Raw) { 234 | /// let p = v.as_pointer::(); 235 | /// p.drop_in_place() 236 | /// } 237 | /// 238 | /// ocaml::custom!(MyType2 { 239 | /// finalize: mytype2_finalizer 240 | /// }); 241 | /// ``` 242 | #[macro_export] 243 | macro_rules! custom_finalize { 244 | ($name:ident $(<$t:tt>)?, $f:path) => { 245 | $crate::custom!($name { finalize: $f }); 246 | }; 247 | } 248 | 249 | /// Default `CustomOps` value 250 | pub const DEFAULT_CUSTOM_OPS: CustomOps = CustomOps { 251 | identifier: core::ptr::null(), 252 | fixed_length: core::ptr::null_mut(), 253 | compare: None, 254 | compare_ext: None, 255 | deserialize: None, 256 | finalize: None, 257 | hash: None, 258 | serialize: None, 259 | }; 260 | -------------------------------------------------------------------------------- /src/error.rs: -------------------------------------------------------------------------------- 1 | use crate::{FromValue, Runtime, ToValue, Value}; 2 | 3 | /// Errors that are translated directly into OCaml exceptions 4 | #[derive(Debug)] 5 | pub enum CamlError { 6 | /// Not_found 7 | NotFound, 8 | 9 | /// Failure 10 | Failure(&'static str), 11 | 12 | /// Invalid_argument 13 | InvalidArgument(&'static str), 14 | 15 | /// Out_of_memory 16 | OutOfMemory, 17 | 18 | /// Stack_overflow 19 | StackOverflow, 20 | 21 | /// Sys_error 22 | SysError(Value), 23 | 24 | /// End_of_file 25 | EndOfFile, 26 | 27 | /// Zero_divide 28 | ZeroDivide, 29 | 30 | /// Array bound error 31 | ArrayBoundError, 32 | 33 | /// Sys_blocked_io 34 | SysBlockedIo, 35 | 36 | /// A pre-allocated OCaml exception 37 | Exception(Value), 38 | 39 | /// An exception type and argument 40 | WithArg(Value, Value), 41 | } 42 | 43 | /// Error returned by `ocaml-rs` functions 44 | #[derive(Debug)] 45 | pub enum Error { 46 | /// A value cannot be called using callback functions 47 | NotCallable, 48 | 49 | /// Array is not a double array 50 | NotDoubleArray, 51 | 52 | /// Error message 53 | Message(&'static str), 54 | 55 | /// General error 56 | #[cfg(not(feature = "no-std"))] 57 | Error(Box), 58 | 59 | /// OCaml exceptions 60 | Caml(CamlError), 61 | } 62 | 63 | #[cfg(not(feature = "no-std"))] 64 | impl From for Error { 65 | fn from(x: T) -> Error { 66 | Error::Error(Box::new(x)) 67 | } 68 | } 69 | 70 | impl From for Error { 71 | fn from(x: CamlError) -> Error { 72 | Error::Caml(x) 73 | } 74 | } 75 | 76 | impl Error { 77 | /// Re-raise an existing exception value 78 | pub fn reraise(exc: Value) -> Result<(), Error> { 79 | Err(CamlError::Exception(exc).into()) 80 | } 81 | 82 | /// Raise an exception that has been registered using `Callback.register_exception` with no 83 | /// arguments 84 | pub fn raise>(exc: S) -> Result<(), Error> { 85 | let value = match unsafe { Value::named(exc.as_ref()) } { 86 | Some(v) => v, 87 | None => { 88 | return Err(Error::Message( 89 | "Value has not been registered with the OCaml runtime", 90 | )) 91 | } 92 | }; 93 | Err(CamlError::Exception(value).into()) 94 | } 95 | 96 | /// Raise an exception that has been registered using `Callback.register_exception` with an 97 | /// argument 98 | pub fn raise_with_arg>(exc: S, arg: Value) -> Result<(), Error> { 99 | let value = match unsafe { Value::named(exc.as_ref()) } { 100 | Some(v) => v, 101 | None => { 102 | return Err(Error::Message( 103 | "Value has not been registered with the OCaml runtime", 104 | )) 105 | } 106 | }; 107 | 108 | Err(CamlError::WithArg(value, arg).into()) 109 | } 110 | 111 | /// Raise `Not_found` 112 | pub fn not_found() -> Result<(), Error> { 113 | Err(CamlError::NotFound.into()) 114 | } 115 | 116 | /// Raise `Out_of_memory` 117 | pub fn out_of_memory() -> Result<(), Error> { 118 | Err(CamlError::OutOfMemory.into()) 119 | } 120 | 121 | /// Raise `Failure` 122 | pub fn failwith(s: &'static str) -> Result<(), Error> { 123 | Err(CamlError::Failure(s).into()) 124 | } 125 | 126 | /// Raise `Invalid_argument` 127 | pub fn invalid_argument(s: &'static str) -> Result<(), Error> { 128 | Err(CamlError::Failure(s).into()) 129 | } 130 | 131 | #[doc(hidden)] 132 | pub fn raise_failure(s: &str) -> ! { 133 | unsafe { 134 | let value = crate::sys::caml_alloc_string(s.len()); 135 | let ptr = crate::sys::string_val(value); 136 | core::ptr::copy_nonoverlapping(s.as_ptr(), ptr, s.len()); 137 | crate::sys::caml_failwith_value(value); 138 | } 139 | #[allow(clippy::empty_loop)] 140 | loop {} 141 | } 142 | 143 | #[doc(hidden)] 144 | pub fn raise_value(v: Value, x: Value) -> ! { 145 | unsafe { 146 | crate::sys::caml_raise_with_arg(v.root().raw().0, x.root().raw().0); 147 | } 148 | #[allow(clippy::empty_loop)] 149 | loop {} 150 | } 151 | 152 | /// Get named error registered using `Callback.register_exception` 153 | pub fn named>(s: S) -> Option { 154 | unsafe { Value::named(s.as_ref()) } 155 | } 156 | } 157 | 158 | unsafe impl ToValue for Result { 159 | fn to_value(&self, rt: &Runtime) -> Value { 160 | unsafe { 161 | match self { 162 | Ok(x) => Value::result_ok(rt, x), 163 | Err(e) => Value::result_error(rt, e), 164 | } 165 | } 166 | } 167 | } 168 | 169 | unsafe impl ToValue for Result { 170 | fn to_value(&self, rt: &Runtime) -> Value { 171 | match self { 172 | Ok(x) => return x.to_value(rt), 173 | Err(Error::Caml(CamlError::Exception(e))) => unsafe { 174 | crate::sys::caml_raise(e.raw().0); 175 | }, 176 | Err(Error::Caml(CamlError::NotFound)) => unsafe { 177 | crate::sys::caml_raise_not_found(); 178 | }, 179 | Err(Error::Caml(CamlError::ArrayBoundError)) => unsafe { 180 | crate::sys::caml_array_bound_error(); 181 | }, 182 | Err(Error::Caml(CamlError::OutOfMemory)) => unsafe { 183 | crate::sys::caml_raise_out_of_memory(); 184 | }, 185 | Err(Error::Caml(CamlError::EndOfFile)) => unsafe { 186 | crate::sys::caml_raise_end_of_file() 187 | }, 188 | Err(Error::Caml(CamlError::StackOverflow)) => unsafe { 189 | crate::sys::caml_raise_stack_overflow() 190 | }, 191 | Err(Error::Caml(CamlError::ZeroDivide)) => unsafe { 192 | crate::sys::caml_raise_zero_divide() 193 | }, 194 | Err(Error::Caml(CamlError::SysBlockedIo)) => unsafe { 195 | crate::sys::caml_raise_sys_blocked_io() 196 | }, 197 | Err(Error::Caml(CamlError::InvalidArgument(s))) => { 198 | unsafe { 199 | let s = crate::util::CString::new(*s).expect("Invalid C string"); 200 | crate::sys::caml_invalid_argument(s.as_ptr() as *const ocaml_sys::Char) 201 | }; 202 | } 203 | Err(Error::Caml(CamlError::WithArg(a, b))) => unsafe { 204 | crate::sys::caml_raise_with_arg(a.raw().0, b.raw().0) 205 | }, 206 | Err(Error::Caml(CamlError::SysError(s))) => { 207 | unsafe { crate::sys::caml_raise_sys_error(s.raw().0) }; 208 | } 209 | Err(Error::Message(s)) => { 210 | unsafe { 211 | let s = crate::util::CString::new(*s).expect("Invalid C string"); 212 | crate::sys::caml_failwith(s.as_ptr() as *const ocaml_sys::Char) 213 | }; 214 | } 215 | Err(Error::Caml(CamlError::Failure(s))) => { 216 | unsafe { 217 | let s = crate::util::CString::new(*s).expect("Invalid C string"); 218 | crate::sys::caml_failwith(s.as_ptr() as *const ocaml_sys::Char) 219 | }; 220 | } 221 | #[cfg(not(feature = "no-std"))] 222 | Err(Error::Error(e)) => { 223 | let s = format!("{:?}\0", e); 224 | unsafe { crate::sys::caml_failwith(s.as_ptr() as *const ocaml_sys::Char) }; 225 | } 226 | Err(Error::NotDoubleArray) => { 227 | let s = "invalid double array\0"; 228 | unsafe { crate::sys::caml_failwith(s.as_ptr() as *const ocaml_sys::Char) }; 229 | } 230 | Err(Error::NotCallable) => { 231 | let s = "value is not callable\0"; 232 | unsafe { crate::sys::caml_failwith(s.as_ptr() as *const ocaml_sys::Char) }; 233 | } 234 | }; 235 | 236 | unreachable!() 237 | } 238 | } 239 | 240 | unsafe impl FromValue for Result { 241 | fn from_value(value: Value) -> Result { 242 | unsafe { 243 | if value.is_exception_result() { 244 | return Err(CamlError::Exception(value).into()); 245 | } 246 | 247 | Ok(T::from_value(value)) 248 | } 249 | } 250 | } 251 | 252 | unsafe impl FromValue for Result { 253 | fn from_value(value: Value) -> Result { 254 | unsafe { value.result() } 255 | } 256 | } 257 | -------------------------------------------------------------------------------- /src/lib.rs: -------------------------------------------------------------------------------- 1 | #![deny(missing_docs)] 2 | #![cfg_attr(feature = "no-std", no_std)] 3 | #![allow(clippy::missing_safety_doc)] 4 | 5 | //! [ocaml-rs](https://github.com/zshipko/ocaml-rs/) is a library for directly interacting with the C OCaml runtime, in Rust. 6 | //! 7 | //! The OCaml manual chapter [Interfacing C with OCaml](https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html) does 8 | //! a great job of explaining low-level details about how to safely interact with the OCaml runtime. This crate aims to 9 | //! be a slightly higher-level of abstraction, with minimal added overhead. 10 | //! 11 | //! ## Getting started 12 | //! 13 | //! Take a look at the [ocaml-rust-starter](http://github.com/zshipko/ocaml-rust-starter) project for a basic example to help get started with `ocaml-rs`. 14 | //! 15 | //! ## Examples 16 | //! 17 | //! ```rust,no_run 18 | //! use ocaml::FromValue; 19 | //! 20 | //! // Automatically derive `ToValue` and `FromValue` 21 | //! #[cfg(feature = "derive")] 22 | //! #[derive(ocaml::ToValue, ocaml::FromValue)] 23 | //! #[ocaml::sig("{name: string; i: int}")] 24 | //! struct Example { 25 | //! name: String, 26 | //! i: ocaml::Int, 27 | //! } 28 | //! 29 | //! #[cfg(feature = "derive")] 30 | //! #[ocaml::func] 31 | //! #[ocaml::sig("example -> example")] 32 | //! pub fn incr_example(mut e: Example) -> Example { 33 | //! e.i += 1; 34 | //! e 35 | //! } 36 | //! 37 | //! #[cfg(feature = "derive")] 38 | //! #[ocaml::func] 39 | //! #[ocaml::sig("int -> int * int * int")] 40 | //! pub fn build_tuple(i: ocaml::Int) -> (ocaml::Int, ocaml::Int, ocaml::Int) { 41 | //! (i + 1, i + 2, i + 3) 42 | //! } 43 | //! 44 | //! /// A name for the garbage collector handle can also be specified: 45 | //! #[cfg(feature = "derive")] 46 | //! #[ocaml::func(my_gc_handle)] 47 | //! #[ocaml::sig("unit -> string")] 48 | //! pub unsafe fn my_string() -> ocaml::Value { 49 | //! ocaml::Value::string("My string") 50 | //! } 51 | //! 52 | //! #[cfg(feature = "derive")] 53 | //! #[ocaml::func] 54 | //! #[ocaml::sig("float array -> float")] 55 | //! pub fn average(arr: ocaml::Array) -> Result { 56 | //! let mut sum = 0f64; 57 | //! 58 | //! for i in 0..arr.len() { 59 | //! sum += arr.get_f64(i)?; 60 | //! } 61 | //! 62 | //! Ok(sum / arr.len() as f64) 63 | //! } 64 | //! 65 | //! // A `native_func` must take `ocaml::Value` for every argument or `f64` for 66 | //! // every unboxed argument and return an `ocaml::Value` (or `f64`). 67 | //! // `native_func` has minimal overhead compared to wrapping with `func` 68 | //! #[cfg(feature = "derive")] 69 | //! #[ocaml::native_func] 70 | //! #[ocaml::sig("int -> int")] 71 | //! pub unsafe fn incr(value: ocaml::Value) -> ocaml::Value { 72 | //! let i = isize::from_value(value); 73 | //! ocaml::Value::int(i + 1) 74 | //! } 75 | //! 76 | //! // This is equivalent to: 77 | //! #[no_mangle] 78 | //! pub unsafe extern "C" fn incr2(value: ocaml::Value) -> ocaml::Value { 79 | //! ocaml::body!(gc: { 80 | //! let i = isize::from_value(value); 81 | //! ocaml::Value::int( i + 1) 82 | //! }) 83 | //! } 84 | //! 85 | //! // `ocaml::native_func` is responsible for: 86 | //! // - Ensures that #[no_mangle] and extern "C" are added, in addition to wrapping 87 | //! // - Wraps the function body using `ocaml::body!` 88 | //! 89 | //! // Finally, if your function is marked [@@unboxed] and [@@noalloc] in OCaml then you can avoid 90 | //! // boxing altogether for f64 arguments using a plain C function and a bytecode function 91 | //! // definition: 92 | //! #[no_mangle] 93 | //! pub extern "C" fn incrf(input: f64) -> f64 { 94 | //! input + 1.0 95 | //! } 96 | //! 97 | //! #[cfg(feature = "derive")] 98 | //! #[ocaml::bytecode_func] 99 | //! pub fn incrf_bytecode(input: f64) -> f64 { 100 | //! incrf(input) 101 | //! } 102 | //! ``` 103 | //! 104 | //! The OCaml stubs would look like this: 105 | //! 106 | //! ```ocaml 107 | //! type example = { 108 | //! name: string; 109 | //! i: int; 110 | //! } 111 | //! 112 | //! external incr_example: example -> example = "incr_example" 113 | //! external build_tuple: int -> int * int * int = "build_tuple" 114 | //! external average: float array -> float = "average" 115 | //! external incr: int -> int = "incr" 116 | //! external incr2: int -> int = "incr2" 117 | //! external incrf: float -> float = "incrf_bytecode" "incrf" [@@unboxed] [@@noalloc] 118 | //! ``` 119 | //! 120 | //! Excluding the `incrf` example, these can also be automatically generated using [ocaml-build](https://github.com/zshipko/ocaml-rs/blob/master/build/README.md) 121 | //! 122 | //! For more information see the [ocaml-rs book](https://zshipko.github.io/ocaml-rs) 123 | 124 | #[cfg(all(feature = "link", feature = "no-std"))] 125 | std::compile_error!("Cannot use link and no-std features"); 126 | 127 | /// The `sys` module contains the low-level implementation of the OCaml runtime 128 | pub use ocaml_sys as sys; 129 | 130 | #[cfg(feature = "derive")] 131 | pub use ocaml_derive::{ 132 | ocaml_bytecode_func as bytecode_func, ocaml_func as func, ocaml_native_func as native_func, 133 | ocaml_sig as sig, FromValue, ToValue, 134 | }; 135 | 136 | #[macro_use] 137 | mod macros; 138 | 139 | mod conv; 140 | mod error; 141 | mod pointer; 142 | mod tag; 143 | mod types; 144 | mod util; 145 | mod value; 146 | 147 | /// Rooted values 148 | pub mod root; 149 | 150 | /// Functions for interacting with the OCaml runtime 151 | pub mod runtime; 152 | 153 | /// Custom types, used for allocating Rust values owned by the OCaml garbage collector 154 | pub mod custom; 155 | 156 | pub use crate::custom::Custom; 157 | pub use crate::error::{CamlError, Error}; 158 | pub use crate::pointer::Pointer; 159 | pub use crate::runtime::Runtime; 160 | pub use crate::runtime::*; 161 | pub use crate::tag::Tag; 162 | pub use crate::types::{bigarray, Array, List, Seq}; 163 | pub use crate::value::{FromValue, Raw, ToValue, Value}; 164 | 165 | /// OCaml `float` 166 | pub type Float = f64; 167 | 168 | /// Integer type that converts to OCaml `int` 169 | pub type Int = sys::Intnat; 170 | 171 | /// Unsigned integer type that converts to OCaml `int` 172 | pub type Uint = sys::Uintnat; 173 | 174 | /// Wraps `sys::COMPILER` as `std::process::Command` 175 | #[cfg(not(any(feature = "no-std", feature = "without-ocamlopt")))] 176 | pub fn ocamlopt() -> std::process::Command { 177 | std::process::Command::new(sys::COMPILER) 178 | } 179 | -------------------------------------------------------------------------------- /src/macros.rs: -------------------------------------------------------------------------------- 1 | /// `body!` is needed to help the OCaml runtime to manage garbage collection, it should 2 | /// be used to wrap the body of each function exported to OCaml. Panics from Rust code 3 | /// will automatically be unwound/caught here (unless the `no-std` feature is enabled) 4 | /// 5 | /// ```rust 6 | /// #[no_mangle] 7 | /// pub unsafe extern "C" fn example(a: ocaml::Value, b: ocaml::Value) -> ocaml::Value { 8 | /// ocaml::body!(gc: { 9 | /// let a = a.int_val(); 10 | /// let b = b.int_val(); 11 | /// ocaml::Value::int(a + b) 12 | /// }) 13 | /// } 14 | /// ``` 15 | #[macro_export] 16 | macro_rules! body { 17 | ($gc:ident: $code:block) => {{ 18 | let $gc = unsafe { &$crate::Runtime::init() }; 19 | 20 | { 21 | $code 22 | } 23 | }}; 24 | } 25 | 26 | #[macro_export] 27 | /// Convenience macro to create an OCaml array 28 | macro_rules! array { 29 | ($($x:expr),*) => {{ 30 | $crate::ToValue::to_value(&vec![$($crate::ToValue::to_value(&$x)),*]) 31 | }} 32 | } 33 | 34 | #[macro_export] 35 | /// Convenience macro to create an OCaml list 36 | macro_rules! list { 37 | ($($x:expr),*) => {{ 38 | let mut l = $crate::list::empty(); 39 | for i in (&[$($x),*]).into_iter().rev() { 40 | $crate::list::push_hd(&mut l, $crate::ToValue::to_value(i)); 41 | } 42 | l 43 | }}; 44 | } 45 | 46 | #[macro_export] 47 | /// Import OCaml functions 48 | macro_rules! import { 49 | ($vis:vis fn $name:ident($($arg:ident: $t:ty),*) $(-> $r:ty)?) => { 50 | $vis unsafe fn $name(rt: &$crate::Runtime, $($arg: $t),*) -> Result<$crate::default_to_unit!($($r)?), $crate::Error> { 51 | use $crate::{ToValue, FromValue}; 52 | type R = $crate::default_to_unit!($($r)?); 53 | let ocaml_rs_named_func = match $crate::Value::named(stringify!($name)) { 54 | Some(x) => x, 55 | None => { 56 | let msg = concat!( 57 | stringify!($name), 58 | " has not been registered using Callback.register" 59 | ); 60 | return Err($crate::Error::Message(msg)); 61 | }, 62 | }; 63 | $(let $arg = $arg.to_value(rt);)* 64 | let __unit = [$crate::Value::unit().raw()]; 65 | let __args = [$($arg.raw()),*]; 66 | let mut args = __args.as_slice(); 67 | if args.is_empty() { 68 | args = &__unit; 69 | } 70 | let x = ocaml_rs_named_func.call_n(args)?; 71 | Ok(R::from_value(x)) 72 | } 73 | }; 74 | ($($vis:vis fn $name:ident($($arg:ident: $t:ty),*) $(-> $r:ty)?;)+) => { 75 | $( 76 | $crate::import!($vis fn $name($($arg: $t),*) $(-> $r)?); 77 | )* 78 | } 79 | } 80 | 81 | #[macro_export] 82 | /// Convert OCaml value into a callable closure 83 | /// 84 | /// For example, if you have an OCaml closure stored in `f` that accepts two `int` parameters, 85 | /// and returns a string, then you can create a Rust closure like this: 86 | /// ```rust 87 | /// #[ocaml::func] 88 | /// #[ocaml::sig("(int -> int -> string) -> int -> int -> string")] 89 | /// pub fn call_function(f: ocaml::Value, a: ocaml::Int, b: ocaml::Int) -> Result { 90 | /// let f = ocaml::function!(f, (a: ocaml::Int, b: ocaml::Int) -> String); 91 | /// f(gc, &a, &b) 92 | /// } 93 | /// ``` 94 | macro_rules! function { 95 | ($x:expr, ($($argname:ident: $arg:ty),*) -> $r:ty) => { 96 | |gc: &$crate::Runtime, $($argname: &$arg),*| -> Result<$r, $crate::Error> { 97 | let args = [$($crate::ToValue::to_value($argname, gc)),*]; 98 | #[allow(unused_unsafe)] 99 | unsafe { $crate::Value::call(&$x, gc, args) } 100 | } 101 | }; 102 | } 103 | 104 | #[doc(hidden)] 105 | #[macro_export] 106 | macro_rules! default_to_unit { 107 | // No return value, default to unit 108 | () => { 109 | () 110 | }; 111 | 112 | // Return value specified 113 | ($rtyp:ty) => { 114 | $rtyp 115 | }; 116 | } 117 | -------------------------------------------------------------------------------- /src/pointer.rs: -------------------------------------------------------------------------------- 1 | #![allow(unknown_lints)] 2 | #![allow(clippy::derive_partial_eq_without_eq)] 3 | 4 | use core::marker::PhantomData; 5 | 6 | use crate::{Custom, FromValue, Raw, Runtime, ToValue, Value}; 7 | 8 | /// A handle to a Rust value/reference owned by the OCaml heap. 9 | /// 10 | /// This should only be used with values allocated with `alloc_final` or `alloc_custom`, 11 | /// for abstract pointers see `Value::alloc_abstract_ptr` and `Value::abstract_ptr_val` 12 | #[derive(Clone, PartialEq, PartialOrd, Eq)] 13 | #[repr(transparent)] 14 | pub struct Pointer(pub Value, PhantomData); 15 | 16 | unsafe impl ToValue for Pointer { 17 | fn to_value(&self, _rt: &Runtime) -> Value { 18 | self.0.clone() 19 | } 20 | } 21 | 22 | unsafe impl FromValue for Pointer { 23 | fn from_value(value: Value) -> Self { 24 | Pointer(value, PhantomData) 25 | } 26 | } 27 | 28 | impl From for Pointer { 29 | fn from(x: T) -> Self { 30 | Pointer::alloc_custom(x) 31 | } 32 | } 33 | 34 | unsafe extern "C" fn drop_value(raw: Raw) { 35 | let p = raw.as_pointer::(); 36 | p.drop_in_place(); 37 | } 38 | 39 | impl Pointer { 40 | /// Allocate a `Custom` value 41 | pub fn alloc_custom(x: T) -> Pointer 42 | where 43 | T: Custom, 44 | { 45 | unsafe { 46 | let mut ptr = Pointer(Value::alloc_custom::(), PhantomData); 47 | ptr.set(x); 48 | ptr 49 | } 50 | } 51 | } 52 | 53 | impl Pointer { 54 | /// Allocate a new value with an optional custom finalizer and used/max 55 | /// 56 | /// This calls `caml_alloc_final` under-the-hood, which can has less than ideal performance 57 | /// behavior. In most cases you should prefer `Poiner::alloc_custom` when possible. 58 | pub fn alloc_final( 59 | x: T, 60 | finalizer: Option, 61 | used_max: Option<(usize, usize)>, 62 | ) -> Pointer { 63 | unsafe { 64 | let value = match finalizer { 65 | Some(f) => Value::alloc_final::(f, used_max), 66 | None => Value::alloc_final::(drop_value::, used_max), 67 | }; 68 | let mut ptr = Pointer(value, PhantomData); 69 | ptr.set(x); 70 | ptr 71 | } 72 | } 73 | 74 | /// Allocate a new abstract value 75 | pub fn alloc(x: T) -> Pointer { 76 | Self::alloc_final(x, None, None) 77 | } 78 | 79 | /// Drop pointer in place 80 | /// 81 | /// # Safety 82 | /// This should only be used when you're in control of the underlying value and want to drop 83 | /// it. It should only be called once. 84 | pub unsafe fn drop_in_place(mut self) { 85 | core::ptr::drop_in_place(self.as_mut_ptr()) 86 | } 87 | 88 | /// Replace the inner value with the provided argument 89 | pub fn set(&mut self, x: T) { 90 | unsafe { 91 | core::ptr::write_unaligned(self.as_mut_ptr(), x); //core::ptr::read_unaligned(x)); 92 | } 93 | } 94 | 95 | /// Access the underlying pointer 96 | pub fn as_ptr(&self) -> *const T { 97 | unsafe { self.0.custom_ptr_val() } 98 | } 99 | 100 | /// Access the underlying mutable pointer 101 | pub fn as_mut_ptr(&mut self) -> *mut T { 102 | unsafe { self.0.custom_ptr_val_mut() } 103 | } 104 | } 105 | 106 | impl AsRef for Pointer { 107 | fn as_ref(&self) -> &T { 108 | unsafe { &*self.as_ptr() } 109 | } 110 | } 111 | 112 | impl AsMut for Pointer { 113 | fn as_mut(&mut self) -> &mut T { 114 | unsafe { &mut *self.as_mut_ptr() } 115 | } 116 | } 117 | -------------------------------------------------------------------------------- /src/root.rs: -------------------------------------------------------------------------------- 1 | use crate::sys; 2 | 3 | /// Wraps rooted values 4 | pub struct Root(pub ocaml_boxroot_sys::BoxRoot); 5 | 6 | impl PartialEq for Root { 7 | fn eq(&self, other: &Self) -> bool { 8 | ocaml_boxroot_sys::boxroot_get_ref(self.0) == ocaml_boxroot_sys::boxroot_get_ref(other.0) 9 | } 10 | } 11 | 12 | impl PartialOrd for Root { 13 | fn partial_cmp(&self, other: &Self) -> Option { 14 | ocaml_boxroot_sys::boxroot_get_ref(self.0) 15 | .partial_cmp(&ocaml_boxroot_sys::boxroot_get_ref(other.0)) 16 | } 17 | } 18 | 19 | impl core::fmt::Debug for Root { 20 | fn fmt(&self, f: &mut core::fmt::Formatter<'_>) -> core::fmt::Result { 21 | ocaml_boxroot_sys::boxroot_get_ref(self.0).fmt(f) 22 | } 23 | } 24 | 25 | impl Eq for Root {} 26 | 27 | // Adaptation from C++: https://gitlab.com/ocaml-rust/ocaml-boxroot/-/blob/c119eb0c88f3f628e683ee90f1b694b51c60a0cb/boxroot/cpp/boxroot.cpp 28 | fn boxroot_raise_error() -> ! { 29 | use ocaml_boxroot_sys::Status; 30 | let status = unsafe { ocaml_boxroot_sys::boxroot_status() }; 31 | let error_message = match status { 32 | Status::ToreDown => "boxroot_teardown has previously been called", 33 | Status::Invalid => "With systhreads, boxroot_setup must be called after caml_thread_initialize but before any thread is created", 34 | Status::Running | Status::NotSetup => { 35 | #[cfg(not(feature = "no-std"))] 36 | { 37 | use std::io::{Error, ErrorKind}; 38 | match Error::last_os_error().kind() { 39 | ErrorKind::PermissionDenied => { 40 | "You tried calling boxroot_create or boxroot_modify without holding the domain lock" 41 | } 42 | ErrorKind::OutOfMemory => { 43 | "Allocation failure of the backing store" 44 | } 45 | _ => "Unknown Error::last_os_error().kind()", 46 | } 47 | } 48 | #[cfg(feature = "no-std")] 49 | { 50 | "Unknown error (details unavailable in no-std environment)" 51 | } 52 | } 53 | _ => "Unknown ocaml_boxroot_sys::Status", 54 | }; 55 | 56 | panic!("Boxroot error: {}", error_message); 57 | } 58 | 59 | impl Root { 60 | /// Create a new root 61 | pub unsafe fn new(v: sys::Value) -> Root { 62 | match ocaml_boxroot_sys::boxroot_create(v) { 63 | Some(root) => Root(root), 64 | None => boxroot_raise_error(), 65 | } 66 | } 67 | 68 | /// Get value from root 69 | pub unsafe fn get(&self) -> sys::Value { 70 | ocaml_boxroot_sys::boxroot_get(self.0) 71 | } 72 | 73 | /// Modify root 74 | pub unsafe fn modify(&mut self, v: sys::Value) { 75 | if !ocaml_boxroot_sys::boxroot_modify(&mut self.0, v) { 76 | panic!("boxroot_modify failed") 77 | } 78 | } 79 | } 80 | 81 | impl Clone for Root { 82 | fn clone(&self) -> Root { 83 | unsafe { Root::new(self.get()) } 84 | } 85 | } 86 | 87 | impl Drop for Root { 88 | fn drop(&mut self) { 89 | unsafe { ocaml_boxroot_sys::boxroot_delete(self.0) } 90 | } 91 | } 92 | -------------------------------------------------------------------------------- /src/runtime.rs: -------------------------------------------------------------------------------- 1 | /// OCaml runtime handle 2 | pub struct Runtime { 3 | _panic_guard: PanicGuard, 4 | } 5 | 6 | static RUNTIME_INIT: core::sync::atomic::AtomicBool = core::sync::atomic::AtomicBool::new(false); 7 | 8 | impl Runtime { 9 | /// Initialize the OCaml runtime. 10 | pub fn init() -> Self { 11 | Self::init_persistent(); 12 | Self { 13 | _panic_guard: PanicGuard::new(), 14 | } 15 | } 16 | 17 | /// Initializes the OCaml runtime. 18 | /// 19 | /// After the first invocation, this method does nothing. 20 | pub fn init_persistent() { 21 | #[cfg(not(feature = "no-caml-startup"))] 22 | { 23 | if RUNTIME_INIT 24 | .compare_exchange( 25 | false, 26 | true, 27 | core::sync::atomic::Ordering::Relaxed, 28 | core::sync::atomic::Ordering::Relaxed, 29 | ) 30 | .is_err() 31 | { 32 | return; 33 | } 34 | 35 | let arg0 = c"ocaml".as_ptr() as *const ocaml_sys::Char; 36 | let c_args = [arg0, core::ptr::null()]; 37 | unsafe { 38 | ocaml_sys::caml_startup(c_args.as_ptr()); 39 | assert!(ocaml_boxroot_sys::boxroot_setup()); 40 | } 41 | } 42 | #[cfg(feature = "no-caml-startup")] 43 | panic!("Rust code that is called from an OCaml program should not try to initialize the runtime."); 44 | } 45 | 46 | #[doc(hidden)] 47 | #[inline(always)] 48 | pub unsafe fn recover_handle() -> &'static Self { 49 | static RUNTIME: Runtime = Runtime { 50 | _panic_guard: PanicGuard, 51 | }; 52 | &RUNTIME 53 | } 54 | 55 | /// Wrapper for `caml_leave_blocking_section` 56 | pub fn leave_blocking_section(&self) { 57 | unsafe { crate::sys::caml_leave_blocking_section() } 58 | } 59 | 60 | /// Wrapper for `caml_leave_blocking_section` 61 | pub fn enter_blocking_section(&self) { 62 | unsafe { crate::sys::caml_enter_blocking_section() } 63 | } 64 | } 65 | 66 | /// Initialize the OCaml runtime, the runtime will be 67 | /// freed when the value goes out of scope 68 | pub fn init() -> Runtime { 69 | Runtime::init() 70 | } 71 | 72 | /// Initialize the OCaml runtime 73 | pub fn init_persistent() { 74 | Runtime::init_persistent(); 75 | } 76 | 77 | /// Wrapper for `caml_leave_blocking_section` 78 | pub fn leave_blocking_section() { 79 | unsafe { crate::sys::caml_leave_blocking_section() } 80 | } 81 | 82 | /// Wrapper for `caml_leave_blocking_section` 83 | pub fn enter_blocking_section() { 84 | unsafe { crate::sys::caml_enter_blocking_section() } 85 | } 86 | 87 | /// Run minor GC collection 88 | pub fn gc_minor() { 89 | unsafe { 90 | ocaml_sys::caml_gc_minor(ocaml_sys::UNIT); 91 | } 92 | } 93 | 94 | /// Run major GC collection 95 | pub unsafe fn gc_major() { 96 | ocaml_sys::caml_gc_major(ocaml_sys::UNIT); 97 | } 98 | 99 | /// Run full major GC collection 100 | pub unsafe fn gc_full_major() { 101 | ocaml_sys::caml_gc_full_major(ocaml_sys::UNIT); 102 | } 103 | 104 | /// Run compaction 105 | pub unsafe fn gc_compact() { 106 | ocaml_sys::caml_gc_compaction(ocaml_sys::UNIT); 107 | } 108 | 109 | #[cfg(not(feature = "no-std"))] 110 | thread_local! { 111 | #[allow(clippy::missing_const_for_thread_local)] 112 | static GUARD_COUNT: core::cell::Cell = const { core::cell::Cell::new(0) }; 113 | } 114 | 115 | #[cfg(not(feature = "no-std"))] 116 | static INIT: std::sync::Once = std::sync::Once::new(); 117 | 118 | struct PanicGuard; 119 | 120 | impl PanicGuard { 121 | #[cfg(not(any(feature = "no-panic-hook", feature = "no-std")))] 122 | pub(crate) fn new() -> Self { 123 | INIT.call_once(|| { 124 | let original_hook = std::panic::take_hook(); 125 | std::panic::set_hook(Box::new(move |panic_info| { 126 | if GUARD_COUNT.with(|count| count.get()) > 0 { 127 | let err = panic_info.payload(); 128 | let msg = if let Some(s) = err.downcast_ref::<&str>() { 129 | s.to_string() 130 | } else if let Some(s) = err.downcast_ref::() { 131 | s.clone() 132 | } else { 133 | format!("{:?}", err) 134 | }; 135 | crate::Error::raise_failure(&msg); 136 | } else { 137 | original_hook(panic_info); 138 | } 139 | })); 140 | }); 141 | 142 | GUARD_COUNT.with(|count| count.set(count.get() + 1)); 143 | PanicGuard 144 | } 145 | 146 | #[cfg(any(feature = "no-panic-hook", feature = "no-std"))] 147 | pub(crate) fn new() -> Self { 148 | PanicGuard 149 | } 150 | } 151 | 152 | #[cfg(not(any(feature = "no-panic-hook", feature = "no-std")))] 153 | impl Drop for PanicGuard { 154 | fn drop(&mut self) { 155 | GUARD_COUNT.with(|count| count.set(count.get() - 1)); 156 | } 157 | } 158 | -------------------------------------------------------------------------------- /src/tag.rs: -------------------------------------------------------------------------------- 1 | use crate::sys; 2 | 3 | /// OCaml tags are used to provide type information to the garbage collector 4 | /// 5 | /// Create a tag from an integer: 6 | /// 7 | /// ```rust 8 | /// let _ = ocaml::Tag(0); 9 | /// ``` 10 | #[repr(transparent)] 11 | #[derive(Clone, Copy, Debug, PartialEq, PartialOrd, Default, Eq)] 12 | pub struct Tag(pub sys::Tag); 13 | 14 | impl From for u8 { 15 | fn from(t: Tag) -> u8 { 16 | t.0 17 | } 18 | } 19 | 20 | impl From for Tag { 21 | fn from(x: u8) -> Tag { 22 | Tag(x) 23 | } 24 | } 25 | 26 | macro_rules! tag_def { 27 | ($name:ident) => { 28 | pub const $name: Tag = Tag(sys::$name); 29 | }; 30 | } 31 | 32 | #[allow(missing_docs)] 33 | impl Tag { 34 | tag_def!(FORWARD); 35 | tag_def!(INFIX); 36 | tag_def!(OBJECT); 37 | tag_def!(CLOSURE); 38 | tag_def!(LAZY); 39 | tag_def!(ABSTRACT); 40 | tag_def!(NO_SCAN); 41 | tag_def!(STRING); 42 | tag_def!(DOUBLE); 43 | tag_def!(DOUBLE_ARRAY); 44 | tag_def!(CUSTOM); 45 | } 46 | -------------------------------------------------------------------------------- /src/types.rs: -------------------------------------------------------------------------------- 1 | #![allow(unknown_lints)] 2 | #![allow(clippy::derive_partial_eq_without_eq)] 3 | 4 | //! OCaml types represented in Rust, these are zero-copy and incur no additional overhead 5 | 6 | use crate::{sys, CamlError, Error, Raw, Runtime, Tag}; 7 | 8 | use core::{ 9 | iter::{IntoIterator, Iterator}, 10 | marker::PhantomData, 11 | mem, slice, 12 | }; 13 | 14 | use crate::value::{FromValue, Size, ToValue, Value}; 15 | 16 | #[derive(Clone, PartialEq, Eq)] 17 | #[repr(transparent)] 18 | /// Seq wraps `'a Seq.t` without converting it to Rust 19 | pub struct Seq(Value, PhantomData); 20 | 21 | unsafe impl ToValue for Seq { 22 | fn to_value(&self, _rt: &Runtime) -> Value { 23 | self.0.clone() 24 | } 25 | } 26 | 27 | unsafe impl FromValue for Seq { 28 | fn from_value(value: Value) -> Self { 29 | Seq(value, PhantomData) 30 | } 31 | } 32 | 33 | impl core::iter::Iterator for Seq { 34 | type Item = Result; 35 | 36 | fn next(&mut self) -> Option { 37 | unsafe { 38 | match self.0.seq_next() { 39 | Ok(Some((x, next))) => { 40 | self.0 = next; 41 | Some(Ok(T::from_value(x))) 42 | } 43 | Ok(None) => None, 44 | Err(e) => Some(Err(e)), 45 | } 46 | } 47 | } 48 | } 49 | 50 | /// `Array` wraps an OCaml `'a array` without converting it to Rust 51 | #[derive(Clone, PartialEq, Eq)] 52 | #[repr(transparent)] 53 | pub struct Array(Value, PhantomData); 54 | 55 | unsafe impl ToValue for Array { 56 | fn to_value(&self, _rt: &Runtime) -> Value { 57 | self.0.clone() 58 | } 59 | } 60 | 61 | unsafe impl FromValue for Array { 62 | fn from_value(value: Value) -> Self { 63 | Array(value, PhantomData) 64 | } 65 | } 66 | 67 | impl Array { 68 | /// Set value to double array 69 | pub fn set_double(&mut self, i: usize, f: f64) -> Result<(), Error> { 70 | if i >= self.len() { 71 | return Err(CamlError::ArrayBoundError.into()); 72 | } 73 | 74 | if !self.is_f64() { 75 | return Err(Error::NotDoubleArray); 76 | } 77 | 78 | unsafe { 79 | self.set_f64_unchecked(i, f); 80 | }; 81 | 82 | Ok(()) 83 | } 84 | 85 | /// Set value to double array without bounds checking 86 | /// 87 | /// # Safety 88 | /// This function performs no bounds checking 89 | #[inline] 90 | pub unsafe fn set_f64_unchecked(&mut self, i: usize, f: f64) { 91 | self.0.store_double_field(i, f) 92 | } 93 | 94 | /// Get a value from a double array 95 | pub fn get_f64(&self, i: usize) -> Result { 96 | if i >= self.len() { 97 | return Err(CamlError::ArrayBoundError.into()); 98 | } 99 | if !self.is_f64() { 100 | return Err(Error::NotDoubleArray); 101 | } 102 | 103 | Ok(unsafe { self.get_double_unchecked(i) }) 104 | } 105 | 106 | /// Get a value from a double array without checking if the array is actually a double array 107 | /// 108 | /// # Safety 109 | /// 110 | /// This function does not perform bounds checking 111 | #[inline] 112 | pub unsafe fn get_double_unchecked(&self, i: usize) -> f64 { 113 | self.0.double_field(i) 114 | } 115 | } 116 | 117 | impl Array { 118 | /// Allocate a new Array 119 | pub unsafe fn alloc(n: usize) -> Array { 120 | let x = Value::alloc(n, Tag(0)); 121 | Array(x, PhantomData) 122 | } 123 | 124 | /// Check if Array contains only doubles, if so `get_f64` and `set_f64` should be used 125 | /// to access values 126 | pub fn is_f64(&self) -> bool { 127 | unsafe { sys::caml_is_double_array(self.0.raw().0) == 1 } 128 | } 129 | 130 | /// Array length 131 | pub fn len(&self) -> usize { 132 | unsafe { sys::caml_array_length(self.0.raw().0) } 133 | } 134 | 135 | /// Returns true when the array is empty 136 | pub fn is_empty(&self) -> bool { 137 | self.len() == 0 138 | } 139 | 140 | /// Set array index 141 | pub unsafe fn set(&mut self, rt: &Runtime, i: usize, v: &T) -> Result<(), Error> { 142 | if i >= self.len() { 143 | return Err(CamlError::ArrayBoundError.into()); 144 | } 145 | 146 | if self.is_f64() { 147 | self.0.store_double_field(i, v.to_value(rt).double_val()) 148 | } else { 149 | self.set_unchecked(rt, i, v); 150 | } 151 | Ok(()) 152 | } 153 | 154 | /// Set array index without bounds checking 155 | /// 156 | /// # Safety 157 | /// 158 | /// This function does not perform bounds checking 159 | #[inline] 160 | pub unsafe fn set_unchecked(&mut self, rt: &Runtime, i: usize, v: &T) { 161 | self.0.store_field(rt, i, v); 162 | } 163 | 164 | /// Get array index 165 | pub unsafe fn get(&self, rt: &Runtime, i: usize) -> Result { 166 | if i >= self.len() { 167 | return Err(CamlError::ArrayBoundError.into()); 168 | } 169 | 170 | if self.is_f64() { 171 | return Ok(FromValue::from_value(self.0.double_field(i).to_value(rt))); 172 | } 173 | 174 | Ok(self.get_unchecked(i)) 175 | } 176 | 177 | /// Get array index without bounds checking 178 | /// 179 | /// # Safety 180 | /// 181 | /// This function does not perform bounds checking 182 | #[inline] 183 | pub unsafe fn get_unchecked(&self, i: usize) -> T { 184 | FromValue::from_value(self.0.field(i)) 185 | } 186 | 187 | #[doc(hidden)] 188 | pub fn as_slice(&self) -> &[Raw] { 189 | unsafe { self.0.slice() } 190 | } 191 | 192 | #[doc(hidden)] 193 | pub fn as_mut_slice(&mut self) -> &mut [Raw] { 194 | unsafe { self.0.slice_mut() } 195 | } 196 | 197 | /// Array as `Vec` 198 | #[cfg(not(feature = "no-std"))] 199 | pub fn into_vec(self) -> Vec { 200 | FromValue::from_value(self.0) 201 | } 202 | 203 | /// Array as `Vec` 204 | #[cfg(not(feature = "no-std"))] 205 | pub unsafe fn as_vec(&self, rt: &Runtime) -> Result, Error> { 206 | let mut dest = Vec::new(); 207 | let len = self.len(); 208 | 209 | for i in 0..len { 210 | let x = self.get(rt, i)?; 211 | dest.push(x) 212 | } 213 | 214 | Ok(dest) 215 | } 216 | } 217 | 218 | /// `List` wraps an OCaml `'a list` without converting it to Rust, this introduces no 219 | /// additional overhead compared to a `Value` type 220 | #[derive(Clone, PartialEq, Eq)] 221 | #[repr(transparent)] 222 | pub struct List(Value, PhantomData); 223 | 224 | unsafe impl ToValue for List { 225 | fn to_value(&self, _rt: &Runtime) -> Value { 226 | self.0.clone() 227 | } 228 | } 229 | 230 | unsafe impl FromValue for List { 231 | fn from_value(value: Value) -> Self { 232 | List(value, PhantomData) 233 | } 234 | } 235 | 236 | impl List { 237 | /// An empty list 238 | #[inline(always)] 239 | pub fn empty() -> List { 240 | List(Value::unit(), PhantomData) 241 | } 242 | 243 | /// Returns the number of items in `self` 244 | pub unsafe fn len(&self) -> usize { 245 | let mut length = 0; 246 | let mut tmp = self.0.raw(); 247 | while tmp.0 != sys::EMPTY_LIST { 248 | let p = sys::field(tmp.0, 1); 249 | if p.is_null() { 250 | break; 251 | } 252 | tmp = (*p).into(); 253 | length += 1; 254 | } 255 | length 256 | } 257 | 258 | /// Returns true when the list is empty 259 | pub fn is_empty(&self) -> bool { 260 | self.0 == Self::empty().0 261 | } 262 | 263 | /// Add an element to the front of the list returning the new list 264 | #[must_use] 265 | #[allow(clippy::should_implement_trait)] 266 | pub unsafe fn add(self, rt: &Runtime, v: &T) -> List { 267 | let item = v.to_value(rt); 268 | let mut dest = Value::alloc(2, Tag(0)); 269 | dest.store_field(rt, 0, &item); 270 | dest.store_field(rt, 1, &self.0); 271 | List(dest, PhantomData) 272 | } 273 | 274 | /// List head 275 | pub fn hd(&self) -> Option { 276 | if self.is_empty() { 277 | return None; 278 | } 279 | 280 | unsafe { Some(self.0.field(0)) } 281 | } 282 | 283 | /// List tail 284 | pub fn tl(&self) -> List { 285 | if self.is_empty() { 286 | return Self::empty(); 287 | } 288 | 289 | unsafe { List(self.0.field(1), PhantomData) } 290 | } 291 | 292 | #[cfg(not(feature = "no-std"))] 293 | /// List as `Vec` 294 | pub fn into_vec(self) -> Vec { 295 | self.into_iter().map(T::from_value).collect() 296 | } 297 | 298 | #[cfg(not(feature = "no-std"))] 299 | /// List as `LinkedList` 300 | pub fn into_linked_list(self) -> std::collections::LinkedList { 301 | FromValue::from_value(self.0) 302 | } 303 | 304 | /// List iterator 305 | #[allow(clippy::should_implement_trait)] 306 | pub fn into_iter(self) -> ListIterator { 307 | ListIterator { inner: self.0 } 308 | } 309 | } 310 | 311 | impl IntoIterator for List { 312 | type Item = Value; 313 | type IntoIter = ListIterator; 314 | 315 | fn into_iter(self) -> Self::IntoIter { 316 | List::into_iter(self) 317 | } 318 | } 319 | 320 | /// List iterator. 321 | pub struct ListIterator { 322 | inner: Value, 323 | } 324 | 325 | impl Iterator for ListIterator { 326 | type Item = Value; 327 | 328 | fn next(&mut self) -> Option { 329 | if self.inner.raw().0 != sys::UNIT { 330 | unsafe { 331 | let val = self.inner.field(0); 332 | self.inner = self.inner.field(1); 333 | Some(val) 334 | } 335 | } else { 336 | None 337 | } 338 | } 339 | } 340 | 341 | /// `bigarray` contains wrappers for OCaml `Bigarray` values. These types can be used to transfer arrays of numbers between Rust 342 | /// and OCaml directly without the allocation overhead of an `array` or `list` 343 | pub mod bigarray { 344 | use super::*; 345 | use crate::sys::bigarray; 346 | 347 | /// Bigarray kind 348 | pub trait Kind { 349 | /// Array item type 350 | type T: Clone + Copy; 351 | 352 | /// OCaml bigarray type identifier 353 | fn kind() -> i32; 354 | } 355 | 356 | macro_rules! make_kind { 357 | ($t:ty, $k:ident) => { 358 | impl Kind for $t { 359 | type T = $t; 360 | 361 | fn kind() -> i32 { 362 | bigarray::Kind::$k as i32 363 | } 364 | } 365 | }; 366 | } 367 | 368 | make_kind!(u8, UINT8); 369 | make_kind!(i8, SINT8); 370 | make_kind!(u16, UINT16); 371 | make_kind!(i16, SINT16); 372 | make_kind!(f32, FLOAT32); 373 | make_kind!(f64, FLOAT64); 374 | make_kind!(i64, INT64); 375 | make_kind!(i32, INT32); 376 | make_kind!(char, CHAR); 377 | 378 | /// OCaml Bigarray.Array1 type, this introduces no 379 | /// additional overhead compared to a `Value` type 380 | #[repr(transparent)] 381 | #[derive(Clone, PartialEq, Eq)] 382 | pub struct Array1(Value, PhantomData); 383 | 384 | unsafe impl crate::FromValue for Array1 { 385 | fn from_value(value: Value) -> Array1 { 386 | Array1(value, PhantomData) 387 | } 388 | } 389 | 390 | unsafe impl crate::ToValue for Array1 { 391 | fn to_value(&self, _rt: &Runtime) -> Value { 392 | self.0.clone() 393 | } 394 | } 395 | 396 | impl Array1 { 397 | /// Array1::of_slice is used to convert from a slice to OCaml Bigarray, 398 | /// the `data` parameter must outlive the resulting bigarray or there is 399 | /// no guarantee the data will be valid. Use `Array1::from_slice` to clone the 400 | /// contents of a slice. 401 | pub unsafe fn of_slice(data: &mut [T]) -> Array1 { 402 | let x = Value::new(bigarray::caml_ba_alloc_dims( 403 | T::kind() | bigarray::Managed::EXTERNAL as i32, 404 | 1, 405 | data.as_mut_ptr() as bigarray::Data, 406 | data.len() as sys::Intnat, 407 | )); 408 | Array1(x, PhantomData) 409 | } 410 | 411 | /// Convert from a slice to OCaml Bigarray, copying the array. This is the implemtation 412 | /// used by `Array1::from` for slices to avoid any potential lifetime issues 413 | #[cfg(not(feature = "no-std"))] 414 | pub unsafe fn from_slice(data: impl AsRef<[T]>) -> Array1 { 415 | let x = data.as_ref(); 416 | let mut arr = Array1::::create(x.len()); 417 | let data = arr.data_mut(); 418 | data.copy_from_slice(x); 419 | arr 420 | } 421 | 422 | /// Create a new OCaml `Bigarray.Array1` with the given type and size 423 | pub unsafe fn create(n: Size) -> Array1 { 424 | let data = { bigarray::malloc(n * mem::size_of::()) }; 425 | let x = Value::new(bigarray::caml_ba_alloc_dims( 426 | T::kind() | bigarray::Managed::EXTERNAL as i32, 427 | 1, 428 | data as bigarray::Data, 429 | n as sys::Intnat, 430 | )); 431 | Array1(x, PhantomData) 432 | } 433 | 434 | /// Returns the number of items in `self` 435 | pub fn len(&self) -> Size { 436 | unsafe { 437 | let ba = self.0.custom_ptr_val::(); 438 | let dim = slice::from_raw_parts((*ba).dim.as_ptr() as *const usize, 1); 439 | dim[0] 440 | } 441 | } 442 | 443 | /// Returns true when `self.len() == 0` 444 | pub fn is_empty(&self) -> bool { 445 | self.len() == 0 446 | } 447 | 448 | /// Get underlying data as Rust slice 449 | pub fn data(&self) -> &[T] { 450 | unsafe { 451 | let ba = self.0.custom_ptr_val::(); 452 | slice::from_raw_parts((*ba).data as *const T, self.len()) 453 | } 454 | } 455 | 456 | /// Get underlying data as mutable Rust slice 457 | pub fn data_mut(&mut self) -> &mut [T] { 458 | unsafe { 459 | let ba = self.0.custom_ptr_val::(); 460 | slice::from_raw_parts_mut((*ba).data as *mut T, self.len()) 461 | } 462 | } 463 | } 464 | 465 | #[cfg(all(feature = "bigarray-ext", not(feature = "no-std")))] 466 | pub use super::bigarray_ext::*; 467 | } 468 | 469 | #[cfg(all(feature = "bigarray-ext", not(feature = "no-std")))] 470 | pub(crate) mod bigarray_ext { 471 | use ndarray::{ 472 | ArrayView2, ArrayView3, ArrayViewMut2, ArrayViewMut3, Dimension, Shape, ShapeBuilder, 473 | }; 474 | 475 | use core::{marker::PhantomData, mem, ptr, slice}; 476 | 477 | use crate::{ 478 | bigarray::Kind, 479 | sys::{self, bigarray}, 480 | FromValue, Runtime, ToValue, Value, 481 | }; 482 | 483 | /// OCaml Bigarray.Array2 type, this introduces no 484 | /// additional overhead compared to a `Value` type 485 | #[repr(transparent)] 486 | #[derive(Clone, PartialEq, Eq)] 487 | pub struct Array2(Value, PhantomData); 488 | 489 | impl Array2 { 490 | /// Returns array view 491 | pub fn view(&self) -> ArrayView2 { 492 | let ba = unsafe { self.0.custom_ptr_val::() }; 493 | unsafe { 494 | ArrayView2::from_shape_ptr(build_shape(ba, self.shape()), (*ba).data as *const T) 495 | } 496 | } 497 | 498 | /// Returns mutable array view 499 | pub fn view_mut(&mut self) -> ArrayViewMut2 { 500 | let ba = unsafe { self.0.custom_ptr_val::() }; 501 | unsafe { 502 | ArrayViewMut2::from_shape_ptr(build_shape(ba, self.shape()), (*ba).data as *mut T) 503 | } 504 | } 505 | 506 | /// Returns the shape of `self` 507 | pub fn shape(&self) -> (usize, usize) { 508 | let dim = self.dim(); 509 | (dim[0], dim[1]) 510 | } 511 | 512 | /// Returns the number of items in `self` 513 | pub fn len(&self) -> usize { 514 | let dim = self.dim(); 515 | dim[0] * dim[1] 516 | } 517 | 518 | /// Returns true when the list is empty 519 | pub fn is_empty(&self) -> bool { 520 | self.len() == 0 521 | } 522 | 523 | fn dim(&self) -> &[usize] { 524 | let ba = unsafe { self.0.custom_ptr_val::() }; 525 | unsafe { slice::from_raw_parts((*ba).dim.as_ptr() as *const usize, 2) } 526 | } 527 | } 528 | 529 | unsafe impl FromValue for Array2 { 530 | fn from_value(value: Value) -> Array2 { 531 | Array2(value, PhantomData) 532 | } 533 | } 534 | 535 | unsafe impl ToValue for Array2 { 536 | fn to_value(&self, _rt: &Runtime) -> Value { 537 | self.0.clone() 538 | } 539 | } 540 | 541 | impl Array2 { 542 | /// Create a new OCaml `Bigarray.Array2` with the given type and shape 543 | pub unsafe fn create(dim: ndarray::Ix2) -> Array2 { 544 | let data = bigarray::malloc(dim.size() * mem::size_of::()); 545 | let x = Value::new(bigarray::caml_ba_alloc_dims( 546 | T::kind() | bigarray::Managed::EXTERNAL as i32, 547 | 2, 548 | data as bigarray::Data, 549 | dim[0] as sys::Intnat, 550 | dim[1] as sys::Intnat, 551 | )); 552 | Array2(x, PhantomData) 553 | } 554 | 555 | /// Create Array2 from ndarray 556 | pub unsafe fn from_ndarray(data: ndarray::Array2) -> Array2 { 557 | let dim = data.raw_dim(); 558 | let array = Array2::create(dim); 559 | let ba = { array.0.custom_ptr_val::() }; 560 | { 561 | ptr::copy_nonoverlapping(data.as_ptr(), (*ba).data as *mut T, dim.size()); 562 | } 563 | array 564 | } 565 | } 566 | 567 | /// OCaml Bigarray.Array3 type, this introduces no 568 | /// additional overhead compared to a `Value` type 569 | #[repr(transparent)] 570 | #[derive(Clone, PartialEq, Eq)] 571 | pub struct Array3(Value, PhantomData); 572 | 573 | impl Array3 { 574 | /// Returns array view 575 | pub fn view(&self) -> ArrayView3 { 576 | let ba = unsafe { self.0.custom_ptr_val::() }; 577 | unsafe { 578 | ArrayView3::from_shape_ptr(build_shape(ba, self.shape()), (*ba).data as *const T) 579 | } 580 | } 581 | 582 | /// Returns mutable array view 583 | pub fn view_mut(&mut self) -> ArrayViewMut3 { 584 | let ba = unsafe { self.0.custom_ptr_val::() }; 585 | unsafe { 586 | ArrayViewMut3::from_shape_ptr(build_shape(ba, self.shape()), (*ba).data as *mut T) 587 | } 588 | } 589 | 590 | /// Returns the shape of `self` 591 | pub fn shape(&self) -> (usize, usize, usize) { 592 | let dim = self.dim(); 593 | (dim[0], dim[1], dim[2]) 594 | } 595 | 596 | /// Returns the number of items in `self` 597 | pub fn len(&self) -> usize { 598 | let dim = self.dim(); 599 | dim[0] * dim[1] * dim[2] 600 | } 601 | 602 | /// Returns true when the list is empty 603 | pub fn is_empty(&self) -> bool { 604 | self.len() == 0 605 | } 606 | 607 | fn dim(&self) -> &[usize] { 608 | let ba = unsafe { self.0.custom_ptr_val::() }; 609 | unsafe { slice::from_raw_parts((*ba).dim.as_ptr() as *const usize, 3) } 610 | } 611 | } 612 | 613 | unsafe impl FromValue for Array3 { 614 | fn from_value(value: Value) -> Array3 { 615 | Array3(value, PhantomData) 616 | } 617 | } 618 | 619 | unsafe impl ToValue for Array3 { 620 | fn to_value(&self, _rt: &Runtime) -> Value { 621 | self.0.clone() 622 | } 623 | } 624 | 625 | impl Array3 { 626 | /// Create a new OCaml `Bigarray.Array3` with the given type and shape 627 | pub unsafe fn create(dim: ndarray::Ix3) -> Array3 { 628 | let data = { bigarray::malloc(dim.size() * mem::size_of::()) }; 629 | let x = Value::new(bigarray::caml_ba_alloc_dims( 630 | T::kind() | bigarray::Managed::MANAGED as i32, 631 | 3, 632 | data, 633 | dim[0] as sys::Intnat, 634 | dim[1] as sys::Intnat, 635 | dim[2] as sys::Intnat, 636 | )); 637 | Array3(x, PhantomData) 638 | } 639 | 640 | /// Create Array3 from ndarray 641 | pub unsafe fn from_ndarray(data: ndarray::Array3) -> Array3 { 642 | let dim = data.raw_dim(); 643 | let array = Array3::create(dim); 644 | let ba = { array.0.custom_ptr_val::() }; 645 | { 646 | ptr::copy_nonoverlapping(data.as_ptr(), (*ba).data as *mut T, dim.size()); 647 | } 648 | array 649 | } 650 | } 651 | 652 | fn build_shape( 653 | ba: *const bigarray::Bigarray, 654 | shape: S, 655 | ) -> Shape<::Dim> { 656 | if unsafe { (*ba).is_fortran() } { 657 | shape.f() 658 | } else { 659 | shape.into_shape_with_order() 660 | } 661 | } 662 | } 663 | -------------------------------------------------------------------------------- /src/util/mod.rs: -------------------------------------------------------------------------------- 1 | #[cfg(feature = "no-std")] 2 | pub use cstr_core::CString; 3 | 4 | #[cfg(not(feature = "no-std"))] 5 | pub use std::ffi::CString; 6 | -------------------------------------------------------------------------------- /sys/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "ocaml-sys" 3 | version = "0.26.0" 4 | authors = ["Zach Shipko "] 5 | keywords = ["ocaml", "rust", "ffi"] 6 | repository = "https://github.com/zshipko/ocaml-rs" 7 | license = "ISC" 8 | description = "Low-level OCaml bindings for Rust" 9 | documentation = "https://docs.rs/ocaml-sys" 10 | edition = "2021" 11 | links = "asmrun" 12 | 13 | [dependencies] 14 | cty = "0.2" 15 | 16 | [package.metadata.docs.rs] 17 | features = [ "without-ocamlopt", "ocaml5" ] 18 | 19 | [build-dependencies] 20 | cc = "1" 21 | 22 | [features] 23 | default = [] 24 | link = [] 25 | without-ocamlopt = [] 26 | caml-state = [] 27 | ocaml5 = [] 28 | -------------------------------------------------------------------------------- /sys/build.rs: -------------------------------------------------------------------------------- 1 | #[allow(unused)] 2 | use std::io::{BufRead, Write}; 3 | 4 | const CC_LIB_PREFIX: &str = "NATIVECCLIBS="; 5 | 6 | const FLAT_FLOAT_ARRAY: &str = "FLAT_FLOAT_ARRAY="; 7 | 8 | #[allow(unused)] 9 | fn cc_libs(ocaml_path: &str) -> std::io::Result> { 10 | let path = format!("{}/Makefile.config", ocaml_path); 11 | let f = std::io::BufReader::new(std::fs::File::open(path)?); 12 | let mut output = Vec::new(); 13 | 14 | for line in f.lines().map_while(Result::ok) { 15 | if line.starts_with(CC_LIB_PREFIX) { 16 | let line: Vec<_> = line.split('=').collect(); 17 | let line = line[1].split(' '); 18 | output = line 19 | .filter_map(|x| { 20 | if x.is_empty() { 21 | None 22 | } else { 23 | Some(x.replace("-l", "")) 24 | } 25 | }) 26 | .collect(); 27 | } 28 | } 29 | Ok(output) 30 | } 31 | 32 | #[allow(unused)] 33 | fn flat_float_array(ocaml_path: &str) -> std::io::Result { 34 | let path = format!("{}/Makefile.config", ocaml_path); 35 | let f = std::io::BufReader::new(std::fs::File::open(path)?); 36 | let mut flat_float_array = String::new(); 37 | 38 | for line in f.lines().map_while(Result::ok) { 39 | if line.starts_with(FLAT_FLOAT_ARRAY) { 40 | let line: Vec<_> = line.split('=').collect(); 41 | flat_float_array = line[1].to_string(); 42 | } 43 | } 44 | Ok(flat_float_array) 45 | } 46 | 47 | #[allow(unused)] 48 | fn link(out_dir: std::path::PathBuf, ocamlopt: String, ocaml_path: &str) -> std::io::Result<()> { 49 | let mut f = std::fs::File::create(out_dir.join("runtime.ml")).unwrap(); 50 | write!(f, "")?; 51 | 52 | assert!(std::process::Command::new(ocamlopt) 53 | .args(["-output-complete-obj", "-o"]) 54 | .arg(out_dir.join("rt.o")) 55 | .arg(out_dir.join("runtime.ml")) 56 | .status()? 57 | .success()); 58 | 59 | let ar = std::env::var("AR").unwrap_or_else(|_| "ar".to_string()); 60 | assert!(std::process::Command::new(ar) 61 | .arg("rcs") 62 | .arg(out_dir.join("libruntime.a")) 63 | .arg(out_dir.join("rt.o")) 64 | .status()? 65 | .success()); 66 | 67 | for lib in cc_libs(ocaml_path)? { 68 | println!("cargo:rustc-link-lib={}", lib); 69 | } 70 | 71 | println!("cargo:rustc-link-search={}", out_dir.display()); 72 | println!("cargo:rustc-link-lib=static=runtime"); 73 | 74 | println!("cargo:rustc-link-search={}", ocaml_path); 75 | 76 | println!("cargo:rustc-link-lib=static=asmrun"); 77 | 78 | Ok(()) 79 | } 80 | 81 | #[allow(unused)] 82 | fn run() -> std::io::Result<()> { 83 | println!("cargo:rerun-if-file-changed=sys/ocaml-sys.c"); 84 | println!("cargo:rerun-if-env-changed=OCAMLOPT"); 85 | println!("cargo:rerun-if-env-changed=OCAML_VERSION"); 86 | println!("cargo:rerun-if-env-changed=OCAML_WHERE_PATH"); 87 | println!("cargo:rerun-if-env-changed=OPAM_SWITCH_PREFIX"); 88 | let out_dir = std::path::PathBuf::from(std::env::var("OUT_DIR").unwrap()); 89 | 90 | let ocaml_version = std::env::var("OCAML_VERSION"); 91 | let ocaml_where_path = std::env::var("OCAML_WHERE_PATH"); 92 | let ocamlopt = std::env::var("OCAMLOPT").unwrap_or_else(|_| "ocamlopt".to_string()); 93 | 94 | let version: String; 95 | let ocaml_path: String; 96 | 97 | match (ocaml_version, ocaml_where_path) { 98 | (Ok(ver), Ok(path)) => { 99 | version = ver; 100 | ocaml_path = path; 101 | } 102 | _ => { 103 | version = std::str::from_utf8( 104 | std::process::Command::new(&ocamlopt) 105 | .arg("-version") 106 | .output()? 107 | .stdout 108 | .as_ref(), 109 | ) 110 | .unwrap() 111 | .trim() 112 | .to_owned(); 113 | ocaml_path = std::str::from_utf8( 114 | std::process::Command::new(&ocamlopt) 115 | .arg("-where") 116 | .output()? 117 | .stdout 118 | .as_ref(), 119 | ) 120 | .unwrap() 121 | .trim() 122 | .to_owned(); 123 | } 124 | } 125 | 126 | let bin_path = format!("{}/../../bin/ocamlopt", ocaml_path); 127 | 128 | let mut f = std::fs::File::create(out_dir.join("ocaml_compiler")).unwrap(); 129 | std::io::Write::write_all(&mut f, bin_path.as_bytes()).unwrap(); 130 | 131 | // Write OCaml version to file 132 | let mut f = std::fs::File::create(out_dir.join("ocaml_version")).unwrap(); 133 | std::io::Write::write_all(&mut f, version.as_bytes()).unwrap(); 134 | 135 | // Write OCaml path to file 136 | let mut f = std::fs::File::create(out_dir.join("ocaml_path")).unwrap(); 137 | std::io::Write::write_all(&mut f, ocaml_path.as_bytes()).unwrap(); 138 | 139 | let mut f = std::fs::File::create(out_dir.join("flat_float_array")).unwrap(); 140 | std::io::Write::write_all(&mut f, flat_float_array(&ocaml_path)?.as_bytes()).unwrap(); 141 | 142 | let split: Vec<&str> = version.split('.').collect(); 143 | 144 | let major = split[0].parse::().unwrap(); 145 | let minor = split[1].parse::().unwrap(); 146 | 147 | if major >= 5 || cfg!(feature = "ocaml5") { 148 | println!("cargo:rustc-cfg=feature=\"ocaml5\""); 149 | } 150 | 151 | #[cfg(feature = "link")] 152 | link(out_dir, bin_path, ocaml_path.as_ref())?; 153 | 154 | // Build C bindings 155 | cc::Build::new() 156 | .static_flag(true) 157 | .file("src/ocaml-sys.c") 158 | .include(&ocaml_path) 159 | .compile("ocaml-sys"); 160 | println!("cargo:rustc-link-lib=static=ocaml-sys"); 161 | 162 | Ok(()) 163 | } 164 | 165 | fn main() { 166 | #[cfg(not(feature = "without-ocamlopt"))] 167 | run().unwrap() 168 | } 169 | -------------------------------------------------------------------------------- /sys/src/alloc.rs: -------------------------------------------------------------------------------- 1 | //! External definitions for allocating values in the OCaml runtime 2 | 3 | use crate::{ 4 | mlvalues::{Size, Value}, 5 | tag::Tag, 6 | Char, 7 | }; 8 | 9 | extern "C" { 10 | pub fn caml_alloc(size: Size, tag: Tag) -> Value; 11 | pub fn caml_alloc_small(size: Size, tag: Tag) -> Value; 12 | pub fn caml_alloc_tuple(size: Size) -> Value; 13 | pub fn caml_alloc_string(size: Size) -> Value; // size in bytes 14 | pub fn caml_alloc_initialized_string(size: Size, string: *const Char) -> Value; 15 | pub fn caml_copy_string(string: *const Char) -> Value; 16 | pub fn caml_copy_string_array(arr: *const *const Char) -> Value; 17 | pub fn caml_is_double_array(v: Value) -> i32; 18 | pub fn caml_copy_double(double: f64) -> Value; 19 | pub fn caml_copy_int32(int: i32) -> Value; // defined in [ints.c] 20 | pub fn caml_copy_int64(int: i64) -> Value; // defined in [ints.c] 21 | pub fn caml_copy_nativeint(int: isize) -> Value; // defined in [ints.c] 22 | pub fn caml_alloc_float_array(size: Size) -> Value; 23 | pub fn caml_alloc_array( 24 | value: unsafe extern "C" fn(*const Char) -> Value, 25 | array: *const *const Char, 26 | ) -> Value; 27 | 28 | pub fn caml_alloc_final( 29 | size: Size, 30 | final_fn: extern "C" fn(Value), 31 | consumed: Size, 32 | max: Size, 33 | ) -> Value; 34 | } 35 | -------------------------------------------------------------------------------- /sys/src/bigarray.rs: -------------------------------------------------------------------------------- 1 | //! Bigarray bindings 2 | 3 | use crate::mlvalues::{Intnat, Uintnat, Value}; 4 | use core::ffi::c_void; 5 | 6 | pub type Data = *mut c_void; 7 | 8 | #[repr(C)] 9 | pub struct BigarrayProxy { 10 | refcount: Intnat, 11 | data: Data, 12 | size: Uintnat, 13 | } 14 | 15 | #[repr(C)] 16 | pub struct Bigarray { 17 | pub data: Data, 18 | pub num_dims: Intnat, 19 | pub flags: Intnat, 20 | pub proxy: *const BigarrayProxy, 21 | pub dim: [Intnat; 0], 22 | } 23 | 24 | impl Bigarray { 25 | /// Returns true if array is Fortran contiguous 26 | pub fn is_fortran(&self) -> bool { 27 | (self.flags & Layout::FORTRAN_LAYOUT as isize) != 0 28 | } 29 | } 30 | 31 | #[allow(non_camel_case_types)] 32 | pub enum Managed { 33 | EXTERNAL = 0, /* Data is not allocated by OCaml */ 34 | MANAGED = 0x200, /* Data is allocated by OCaml */ 35 | MAPPED_FILE = 0x400, /* Data is a memory mapped file */ 36 | MANAGED_MASK = 0x600, /* Mask for "managed" bits in flags field */ 37 | } 38 | 39 | #[allow(non_camel_case_types)] 40 | pub enum Kind { 41 | FLOAT32 = 0x00, /* Single-precision floats */ 42 | FLOAT64 = 0x01, /* Double-precision floats */ 43 | SINT8 = 0x02, /* Signed 8-bit integers */ 44 | UINT8 = 0x03, /* Unsigned 8-bit integers */ 45 | SINT16 = 0x04, /* Signed 16-bit integers */ 46 | UINT16 = 0x05, /* Unsigned 16-bit integers */ 47 | INT32 = 0x06, /* Signed 32-bit integers */ 48 | INT64 = 0x07, /* Signed 64-bit integers */ 49 | CAML_INT = 0x08, /* OCaml-style integers (signed 31 or 63 bits) */ 50 | NATIVE_INT = 0x09, /* Platform-native long integers (32 or 64 bits) */ 51 | COMPLEX32 = 0x0a, /* Single-precision complex */ 52 | COMPLEX64 = 0x0b, /* Double-precision complex */ 53 | CHAR = 0x0c, /* Characters */ 54 | KIND_MASK = 0xFF, /* Mask for kind in flags field */ 55 | } 56 | 57 | #[allow(non_camel_case_types)] 58 | pub enum Layout { 59 | C_LAYOUT = 0, /* Row major, indices start at 0 */ 60 | FORTRAN_LAYOUT = 0x100, /* Column major, indices start at 1 */ 61 | } 62 | 63 | extern "C" { 64 | pub fn malloc(size: usize) -> Data; 65 | pub fn caml_ba_alloc(flags: i32, num_dims: i32, data: Data, dim: *const i32) -> Value; 66 | pub fn caml_ba_alloc_dims(flags: i32, num_dims: i32, data: Data, ...) -> Value; 67 | pub fn caml_ba_byte_size(b: *const Bigarray) -> u32; 68 | } 69 | -------------------------------------------------------------------------------- /sys/src/callback.rs: -------------------------------------------------------------------------------- 1 | //! Callbacks from C to OCaml 2 | //! This is also where you initialize the OCaml runtime system via `caml_startup` or `caml_main` 3 | //! 4 | 5 | use crate::mlvalues::Value; 6 | 7 | extern "C" { 8 | pub fn caml_callback(closure: Value, arg: Value) -> Value; 9 | pub fn caml_callback2(closure: Value, arg1: Value, arg2: Value) -> Value; 10 | pub fn caml_callback3(closure: Value, arg1: Value, arg2: Value, arg3: Value) -> Value; 11 | pub fn caml_callbackN(closure: Value, narg: usize, args: *mut Value) -> Value; 12 | 13 | pub fn caml_callback_exn(closure: Value, arg1: Value) -> Value; 14 | pub fn caml_callback2_exn(closure: Value, arg1: Value, arg2: Value) -> Value; 15 | pub fn caml_callback3_exn(closure: Value, arg1: Value, arg2: Value, arg3: Value) -> Value; 16 | pub fn caml_callbackN_exn(closure: Value, narg: usize, args: *mut Value) -> Value; 17 | 18 | pub static mut caml_callback_depth: usize; 19 | } 20 | 21 | pub const fn is_exception_result(val: Value) -> bool { 22 | (val as usize) & 3 == 2 23 | } 24 | 25 | pub const fn extract_exception(val: Value) -> Value { 26 | val & !3 27 | } 28 | -------------------------------------------------------------------------------- /sys/src/custom.rs: -------------------------------------------------------------------------------- 1 | use crate::*; 2 | 3 | use mlvalues::{Intnat, Size, Uintnat}; 4 | 5 | #[repr(C)] 6 | #[derive(Debug, Copy, Clone)] 7 | pub struct custom_fixed_length { 8 | pub bsize_32: Intnat, 9 | pub bsize_64: Intnat, 10 | } 11 | #[repr(C)] 12 | #[derive(Debug, Copy, Clone)] 13 | pub struct custom_operations { 14 | pub identifier: *const Char, 15 | pub finalize: ::core::option::Option, 16 | pub compare: ::core::option::Option i32>, 17 | pub hash: ::core::option::Option Intnat>, 18 | pub serialize: ::core::option::Option< 19 | unsafe extern "C" fn(v: Value, bsize_32: *mut Uintnat, bsize_64: *mut Uintnat), 20 | >, 21 | pub deserialize: 22 | ::core::option::Option Uintnat>, 23 | pub compare_ext: ::core::option::Option i32>, 24 | pub fixed_length: *const custom_fixed_length, 25 | } 26 | extern "C" { 27 | pub fn caml_alloc_custom( 28 | ops: *const custom_operations, 29 | size: Uintnat, 30 | mem: Size, 31 | max: Size, 32 | ) -> Value; 33 | } 34 | extern "C" { 35 | pub fn caml_alloc_custom_mem(ops: *mut custom_operations, size: Uintnat, mem: Size) -> Value; 36 | } 37 | extern "C" { 38 | pub fn caml_register_custom_operations(ops: *mut custom_operations); 39 | } 40 | -------------------------------------------------------------------------------- /sys/src/fail.rs: -------------------------------------------------------------------------------- 1 | use crate::{Char, Value}; 2 | 3 | extern "C" { 4 | pub fn caml_raise(bucket: Value); 5 | pub fn caml_raise_constant(tag: Value); 6 | pub fn caml_raise_with_arg(tag: Value, arg: Value); 7 | pub fn caml_raise_with_args(tag: Value, nargs: i32, arg: *mut Value); 8 | pub fn caml_raise_with_string(tag: Value, msg: *const Char); 9 | pub fn caml_failwith(msg: *const Char); 10 | pub fn caml_failwith_value(msg: Value); 11 | pub fn caml_invalid_argument(msg: *const Char); 12 | pub fn caml_invalid_argument_value(msg: Value); 13 | pub fn caml_raise_out_of_memory(); 14 | pub fn caml_raise_stack_overflow(); 15 | pub fn caml_raise_sys_error(arg1: Value); 16 | pub fn caml_raise_end_of_file(); 17 | pub fn caml_raise_zero_divide(); 18 | pub fn caml_raise_not_found(); 19 | pub fn caml_array_bound_error(); 20 | pub fn caml_raise_sys_blocked_io(); 21 | } 22 | -------------------------------------------------------------------------------- /sys/src/lib.rs: -------------------------------------------------------------------------------- 1 | #![allow(clippy::missing_safety_doc)] 2 | #![allow(clippy::upper_case_acronyms)] 3 | #![no_std] 4 | 5 | pub type Char = cty::c_char; 6 | 7 | #[cfg(not(feature = "without-ocamlopt"))] 8 | pub const VERSION: &str = include_str!(concat!(env!("OUT_DIR"), "/ocaml_version")); 9 | 10 | #[cfg(feature = "without-ocamlopt")] 11 | pub const VERSION: &str = ""; 12 | 13 | #[cfg(not(feature = "without-ocamlopt"))] 14 | pub const PATH: &str = include_str!(concat!(env!("OUT_DIR"), "/ocaml_path")); 15 | 16 | #[cfg(feature = "without-ocamlopt")] 17 | pub const PATH: &str = ""; 18 | 19 | #[cfg(not(feature = "without-ocamlopt"))] 20 | pub const COMPILER: &str = include_str!(concat!(env!("OUT_DIR"), "/ocaml_compiler")); 21 | 22 | #[cfg(feature = "without-ocamlopt")] 23 | pub const COMPILER: &str = ""; 24 | 25 | #[cfg(not(feature = "without-ocamlopt"))] 26 | pub const FLAT_FLOAT_ARRAY: bool = include!(concat!(env!("OUT_DIR"), "/flat_float_array")); 27 | 28 | #[cfg(feature = "without-ocamlopt")] 29 | pub const FLAT_FLOAT_ARRAY: bool = true; 30 | 31 | mod mlvalues; 32 | #[macro_use] 33 | mod memory; 34 | mod alloc; 35 | pub mod bigarray; 36 | mod callback; 37 | mod custom; 38 | mod fail; 39 | mod printexc; 40 | mod runtime; 41 | mod state; 42 | mod tag; 43 | 44 | pub use self::mlvalues::Value; 45 | pub use self::tag::Tag; 46 | pub use alloc::*; 47 | pub use callback::*; 48 | pub use custom::*; 49 | pub use fail::*; 50 | pub use memory::*; 51 | pub use mlvalues::*; 52 | pub use printexc::*; 53 | pub use runtime::*; 54 | pub use state::*; 55 | pub use tag::*; 56 | -------------------------------------------------------------------------------- /sys/src/memory.rs: -------------------------------------------------------------------------------- 1 | //! Defines types and macros primarily for interacting with the OCaml GC. 2 | //! 3 | //! # `CAMLParam` Macros 4 | //! The following macros are used to declare C local variables and 5 | //! function parameters of type `value`. 6 | //! 7 | //! The function body must start with one of the `CAMLparam` macros. 8 | //! If the function has no parameter of type `value], use [CAMLparam0`. 9 | //! If the function has 1 to 5 `value` parameters, use the corresponding 10 | //! 11 | //! `CAMLparam` with the parameters as arguments. 12 | //! If the function has more than 5 `value] parameters, use [CAMLparam5` 13 | //! for the first 5 parameters, and one or more calls to the `CAMLxparam` 14 | //! macros for the others. 15 | //! 16 | //! If the function takes an array of `value`s as argument, use 17 | //! `CAMLparamN] to declare it (or [CAMLxparamN` if you already have a 18 | //! call to `CAMLparam` for some other arguments). 19 | //! 20 | //! If you need local variables of type `value`, declare them with one 21 | //! or more calls to the `CAMLlocal` macros at the beginning of the 22 | //! function, after the call to CAMLparam. Use `CAMLlocalN` (at the 23 | //! beginning of the function) to declare an array of `value`s. 24 | //! 25 | //! Your function may raise an exception or return a `value` with the 26 | //! `CAMLreturn] macro. Its argument is simply the [value` returned by 27 | //! your function. Do NOT directly return a `value] with the [return` 28 | //! keyword. If your function returns void, use `CAMLreturn0`. 29 | //! 30 | //! All the identifiers beginning with "caml__" are reserved by OCaml. 31 | //! Do not use them for anything (local or global variables, struct or 32 | //! union tags, macros, etc.) 33 | //! 34 | 35 | use core::default::Default; 36 | use core::ptr; 37 | 38 | use crate::mlvalues::{field, Size, Value}; 39 | 40 | #[repr(C)] 41 | #[derive(Debug, Clone)] 42 | pub struct CamlRootsBlock { 43 | pub next: *mut CamlRootsBlock, 44 | pub ntables: isize, 45 | pub nitems: isize, 46 | pub tables: [*mut Value; 5], 47 | } 48 | 49 | impl Default for CamlRootsBlock { 50 | fn default() -> CamlRootsBlock { 51 | CamlRootsBlock { 52 | next: ptr::null_mut(), 53 | ntables: 0, 54 | nitems: 0, 55 | tables: [ptr::null_mut(); 5], 56 | } 57 | } 58 | } 59 | 60 | extern "C" { 61 | pub fn caml_modify(addr: *mut Value, value: Value); 62 | pub fn caml_initialize(addr: *mut Value, value: Value); 63 | } 64 | 65 | /// Stores the `$val` at `$offset` in the `$block`. 66 | /// 67 | /// # Original C code 68 | /// 69 | /// ```c 70 | /// Store_field(block, offset, val) do{ \ 71 | /// mlsize_t caml__temp_offset = (offset); \ 72 | /// value caml__temp_val = (val); \ 73 | /// caml_modify (&Field ((block), caml__temp_offset), caml__temp_val); \ 74 | /// }while(0) 75 | /// ``` 76 | /// 77 | /// # Example 78 | /// ```rust,ignore 79 | /// // stores some_value in the first field in the given block 80 | /// store_field!(some_block, 1, some_value) 81 | /// ``` 82 | macro_rules! store_field { 83 | ($block:expr, $offset:expr, $val:expr) => { 84 | let offset = $offset; 85 | let val = $val; 86 | let block = $block; 87 | $crate::memory::caml_modify(field(block, offset), val); 88 | }; 89 | } 90 | 91 | /// Stores the `value` in the `block` at `offset`. 92 | /// 93 | /// # Safety 94 | /// 95 | /// No bounds checking or validation of the OCaml values is done in this function 96 | pub unsafe fn store_field(block: Value, offset: Size, value: Value) { 97 | store_field!(block, offset, value); 98 | } 99 | 100 | extern "C" { 101 | pub fn caml_register_global_root(value: *mut Value); 102 | pub fn caml_remove_global_root(value: *mut Value); 103 | pub fn caml_register_generational_global_root(value: *mut Value); 104 | pub fn caml_remove_generational_global_root(value: *mut Value); 105 | pub fn caml_modify_generational_global_root(value: *mut Value, newval: Value); 106 | } 107 | -------------------------------------------------------------------------------- /sys/src/mlvalues.rs: -------------------------------------------------------------------------------- 1 | //! Contains OCaml types and conversion functions from runtime representations. 2 | use crate::tag::Tag; 3 | 4 | /// OCaml `value` type 5 | pub type Value = isize; 6 | 7 | /// OCaml's integer type 8 | pub type Intnat = isize; 9 | 10 | /// OCaml's unsigned integer type 11 | pub type Uintnat = usize; 12 | 13 | /// OCaml's size type 14 | pub type Size = Uintnat; 15 | pub type Color = Uintnat; 16 | pub type Mark = Uintnat; 17 | 18 | /// An OCaml heap-allocated block header. **NB**: this is currently unimplemented. 19 | /// 20 | /// Structure of the header: 21 | /// 22 | /// For 16-bit and 32-bit architectures: 23 | /// 24 | ///```text 25 | /// +--------+-------+-----+ 26 | /// | wosize | color | tag | 27 | /// +--------+-------+-----+ 28 | /// bits 31 10 9 8 7 0 29 | ///``` 30 | /// 31 | /// For 64-bit architectures: 32 | /// 33 | ///```text 34 | /// +--------+-------+-----+ 35 | /// | wosize | color | tag | 36 | /// +--------+-------+-----+ 37 | /// bits 63 10 9 8 7 0 38 | ///``` 39 | /// 40 | pub type Header = Uintnat; 41 | 42 | /// #ifdef ARCH_BIG_ENDIAN 43 | /// #define Tag_val(val) (((unsigned char *) (val)) [-1]) 44 | /// #else 45 | /// #define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)]) 46 | /// #endif 47 | #[cfg(target_endian = "big")] 48 | #[inline] 49 | pub const unsafe fn tag_val(val: Value) -> Tag { 50 | *(val as *const u8).offset(-1) 51 | } 52 | 53 | #[cfg(target_endian = "little")] 54 | #[inline] 55 | pub unsafe fn tag_val(val: Value) -> Tag { 56 | *(val as *const u8).offset(-(core::mem::size_of::() as isize)) 57 | } 58 | 59 | #[inline] 60 | pub unsafe fn hd_val(val: Value) -> Header { 61 | *(val as *const Header).offset(-1) 62 | } 63 | 64 | #[inline] 65 | pub unsafe fn wosize_val(val: Value) -> Size { 66 | hd_val(val) >> 10 67 | } 68 | 69 | /// `(((intnat)(x) << 1) + 1)` 70 | pub const unsafe fn val_int(i: isize) -> Value { 71 | (i << 1) + 1 72 | } 73 | 74 | pub const unsafe fn int_val(val: Value) -> isize { 75 | val >> 1 76 | } 77 | 78 | pub fn is_block(v: Value) -> bool { 79 | (v & 1) == 0 80 | } 81 | 82 | pub const fn is_long(v: Value) -> bool { 83 | (v & 1) != 0 84 | } 85 | 86 | // #define Max_long (((intnat)1 << (8 * sizeof(value) - 2)) - 1) 87 | // #define Min_long (-((intnat)1 << (8 * sizeof(value) - 2))) 88 | 89 | /// Maximum possible value for an OCaml fixnum. 90 | pub const MAX_FIXNUM: Intnat = (1 << (8 * core::mem::size_of::() - 2)) - 1; 91 | 92 | /// Minimum possible value for an OCaml fixnum. 93 | pub const MIN_FIXNUM: Intnat = -(1 << (8 * core::mem::size_of::() - 2)); 94 | 95 | /// Extract a field from an OCaml value 96 | /// 97 | /// # Safety 98 | /// 99 | /// This function does no bounds checking or validation of the OCaml values 100 | pub unsafe fn field(block: Value, index: usize) -> *mut Value { 101 | (block as *mut Value).add(index) 102 | } 103 | 104 | /// The OCaml `()` (`unit`) value 105 | pub const UNIT: Value = unsafe { val_int(0) }; 106 | 107 | /// The OCaml `None` value 108 | pub const NONE: Value = unsafe { val_int(0) }; 109 | 110 | /// Empty list value 111 | pub const EMPTY_LIST: Value = unsafe { val_int(0) }; 112 | 113 | /// The OCaml `true` value 114 | pub const TRUE: Value = unsafe { val_int(1) }; 115 | 116 | /// OCaml `false` value 117 | pub const FALSE: Value = unsafe { val_int(0) }; 118 | 119 | /// Tag used for OCaml conses 120 | pub const TAG_CONS: Tag = 0; 121 | 122 | /// Tag used for OCaml `Some x` values 123 | pub const TAG_SOME: Tag = 0; 124 | 125 | /// Pointer to the first byte 126 | #[inline] 127 | pub const unsafe fn bp_val(val: Value) -> *const u8 { 128 | val as *const u8 129 | } 130 | 131 | /// Extracts a machine `ptr` to the bytes making up an OCaml `string` 132 | #[inline] 133 | pub const unsafe fn string_val(val: Value) -> *mut u8 { 134 | val as *mut u8 135 | } 136 | 137 | extern "C" { 138 | /// Returns size of the string in `value` in bytes 139 | pub fn caml_string_length(value: Value) -> Size; 140 | pub fn caml_array_length(value: Value) -> Size; 141 | pub fn caml_hash_variant(tag: *const u8) -> Value; 142 | pub fn caml_get_public_method(obj: Value, tag: Value) -> Value; 143 | pub fn caml_sys_store_double_val(x: Value, f: f64); 144 | pub fn caml_sys_double_val(x: Value) -> f64; 145 | pub fn caml_sys_double_field(x: Value, i: Size) -> f64; 146 | pub fn caml_sys_store_double_field(x: Value, index: Size, d: f64); 147 | } 148 | -------------------------------------------------------------------------------- /sys/src/ocaml-sys.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void caml_sys_store_double_val(value x, double f) { Store_double_val(x, f); } 4 | double caml_sys_double_val(value x) { return Double_val(x); } 5 | 6 | double caml_sys_double_field(value x, mlsize_t i) { return Double_field(x, i); } 7 | 8 | void caml_sys_store_double_field(value x, mlsize_t index, double d) { 9 | Store_double_field(x, index, d); 10 | } 11 | 12 | caml_domain_state *caml_sys_get_domain_state() { return Caml_state; } 13 | -------------------------------------------------------------------------------- /sys/src/printexc.rs: -------------------------------------------------------------------------------- 1 | use crate::{Char, Value}; 2 | 3 | extern "C" { 4 | pub fn caml_format_exception(v: Value) -> *const Char; 5 | } 6 | -------------------------------------------------------------------------------- /sys/src/runtime.rs: -------------------------------------------------------------------------------- 1 | use crate::{Char, Value}; 2 | 3 | extern "C" { 4 | pub fn caml_main(argv: *const *const Char); 5 | pub fn caml_startup(argv: *const *const Char); 6 | pub fn caml_shutdown(); 7 | pub fn caml_named_value(name: *const Char) -> *const Value; 8 | pub fn caml_enter_blocking_section(); 9 | pub fn caml_leave_blocking_section(); 10 | pub fn caml_thread_initialize(unit: Value) -> Value; 11 | } 12 | 13 | // GC control 14 | extern "C" { 15 | pub fn caml_gc_minor(v: Value); 16 | pub fn caml_gc_major(v: Value); 17 | pub fn caml_gc_full_major(v: Value); 18 | pub fn caml_gc_compaction(v: Value); 19 | } 20 | -------------------------------------------------------------------------------- /sys/src/state.rs: -------------------------------------------------------------------------------- 1 | #![allow(non_camel_case_types)] 2 | #[allow(unused)] 3 | use crate::{Char, Value}; 4 | 5 | #[repr(C)] 6 | #[derive(Debug, Copy, Clone)] 7 | pub struct caml_ref_table { 8 | pub _address: u8, 9 | } 10 | #[repr(C)] 11 | #[derive(Debug, Copy, Clone)] 12 | pub struct caml_ephe_ref_table { 13 | pub _address: u8, 14 | } 15 | #[repr(C)] 16 | #[derive(Debug, Copy, Clone)] 17 | pub struct caml_custom_table { 18 | pub _address: u8, 19 | } 20 | #[repr(C)] 21 | #[derive(Debug, Copy, Clone)] 22 | pub struct longjmp_buffer { 23 | pub _address: u8, 24 | } 25 | 26 | pub type backtrace_slot = *mut ::core::ffi::c_void; 27 | 28 | #[repr(C)] 29 | #[derive(Debug)] 30 | #[cfg(not(feature = "ocaml5"))] 31 | pub struct caml_domain_state { 32 | pub _young_ptr: *mut Value, 33 | pub _young_limit: *mut Value, 34 | pub _exception_pointer: *mut Char, 35 | pub _young_base: *mut ::core::ffi::c_void, 36 | pub _young_start: *mut Value, 37 | pub _young_end: *mut Value, 38 | pub _young_alloc_start: *mut Value, 39 | pub _young_alloc_end: *mut Value, 40 | pub _young_alloc_mid: *mut Value, 41 | pub _young_trigger: *mut Value, 42 | pub _minor_heap_wsz: usize, 43 | pub _in_minor_collection: isize, 44 | pub _extra_heap_resources_minor: f64, 45 | pub _ref_table: *mut caml_ref_table, 46 | pub _ephe_ref_table: *mut caml_ephe_ref_table, 47 | pub _custom_table: *mut caml_custom_table, 48 | pub _stack_low: *mut Value, 49 | pub _stack_high: *mut Value, 50 | pub _stack_threshold: *mut Value, 51 | pub _extern_sp: *mut Value, 52 | pub _trapsp: *mut Value, 53 | pub _trap_barrier: *mut Value, 54 | pub _external_raise: *mut longjmp_buffer, 55 | pub _exn_bucket: Value, 56 | pub _top_of_stack: *mut Char, 57 | pub _bottom_of_stack: *mut Char, 58 | pub _last_return_address: usize, 59 | pub _gc_regs: *mut Value, 60 | pub _backtrace_active: isize, 61 | pub _backtrace_pos: isize, 62 | pub _backtrace_buffer: *mut backtrace_slot, 63 | pub _backtrace_last_exn: Value, 64 | pub _compare_unordered: isize, 65 | pub _requested_major_slice: isize, 66 | pub _requested_minor_gc: isize, 67 | pub _local_roots: *mut crate::memory::CamlRootsBlock, 68 | pub _stat_minor_words: f64, 69 | pub _stat_promoted_words: f64, 70 | pub _stat_major_words: f64, 71 | pub _stat_minor_collections: isize, 72 | pub _stat_major_collections: isize, 73 | pub _stat_heap_wsz: isize, 74 | pub _stat_top_heap_wsz: isize, 75 | pub _stat_compactions: isize, 76 | pub _stat_heap_chunks: isize, 77 | } 78 | 79 | #[repr(C)] 80 | #[derive(Debug)] 81 | #[cfg(feature = "ocaml5")] 82 | pub struct caml_domain_state { 83 | pub _young_limit: core::sync::atomic::AtomicUsize, 84 | pub _young_ptr: *mut Value, 85 | pub _exception_pointer: *mut Char, 86 | pub _young_start: *mut Value, 87 | pub _young_end: *mut Value, 88 | pub _current_stack: *mut core::ffi::c_void, // TODO: add `struct stack_info` 89 | pub _exn_handler: *mut core::ffi::c_void, 90 | pub _action_pending: core::ffi::c_int, 91 | pub _c_stack: *mut core::ffi::c_void, // TODO: add `struct c_stack_link` 92 | pub _stack_cache: *mut *mut core::ffi::c_void, 93 | pub _gc_regs_buckets: *mut Value, 94 | pub _gc_regs: *mut Value, 95 | pub _minor_tables: *mut core::ffi::c_void, // TODO: add `struct caml_minor_tables` 96 | pub _mark_stack: *mut core::ffi::c_void, // TODO: add `struct mark_stack` 97 | pub _marking_done: crate::Uintnat, 98 | pub _sweeping_done: crate::Uintnat, 99 | pub _allocated_words: crate::Uintnat, 100 | pub _swept_words: crate::Uintnat, 101 | pub _major_work_computed: crate::Intnat, 102 | pub _major_work_todo: crate::Intnat, 103 | pub _major_gc_clock: f64, 104 | pub _local_roots: *mut crate::memory::CamlRootsBlock, 105 | pub _ephe_info: *mut core::ffi::c_void, 106 | pub _final_info: *mut core::ffi::c_void, 107 | pub _backtrace_pos: crate::Intnat, 108 | pub _backtrace_active: crate::Intnat, 109 | pub _backtrace_buffer: *mut backtrace_slot, 110 | pub _backtrace_last_exn: Value, 111 | pub _compare_unordered: crate::Intnat, 112 | pub _oo_next_id_local: crate::Uintnat, 113 | pub _requested_major_slice: crate::Uintnat, 114 | pub _requested_minor_slice: crate::Uintnat, 115 | pub _requested_minor_gc: crate::Uintnat, 116 | pub _requested_external_interrupt: core::sync::atomic::AtomicUsize, 117 | pub _parser_trace: core::ffi::c_int, 118 | pub _minor_heap_wsz: usize, 119 | pub _shared_heap: *mut core::ffi::c_void, 120 | pub _id: core::ffi::c_int, 121 | pub _unique_id: core::ffi::c_int, 122 | pub _dls_root: Value, 123 | pub _extra_heap_resources: f64, 124 | pub _extra_heap_resources_minor: f64, 125 | pub _dependent_size: crate::Uintnat, 126 | pub _dependent_allocated: crate::Uintnat, 127 | pub _caml_extern_state: *mut core::ffi::c_void, 128 | pub _caml_intern_state: *mut core::ffi::c_void, 129 | pub _stat_minor_words: crate::Uintnat, 130 | pub _stat_promoted_words: crate::Uintnat, 131 | pub _stat_major_words: crate::Uintnat, 132 | pub _stat_minor_collections: crate::Intnat, 133 | pub _stat_forced_major_collections: crate::Intnat, 134 | pub _stat_blocks_marked: crate::Uintnat, 135 | pub _inside_stw_handler: core::ffi::c_int, 136 | pub _trap_sp_off: crate::Intnat, 137 | pub _trap_barrier_off: crate::Intnat, 138 | pub _trap_barrier_block: i64, 139 | pub _external_raise: *mut core::ffi::c_void, 140 | pub _extra_params_area: [u8; 0], 141 | } 142 | 143 | extern "C" { 144 | #[doc(hidden)] 145 | pub fn caml_sys_get_domain_state() -> *mut caml_domain_state; 146 | } 147 | 148 | #[doc(hidden)] 149 | pub unsafe fn local_roots() -> *mut crate::memory::CamlRootsBlock { 150 | (*caml_sys_get_domain_state())._local_roots 151 | } 152 | 153 | #[doc(hidden)] 154 | pub unsafe fn set_local_roots(x: *mut crate::memory::CamlRootsBlock) { 155 | (*caml_sys_get_domain_state())._local_roots = x 156 | } 157 | -------------------------------------------------------------------------------- /sys/src/tag.rs: -------------------------------------------------------------------------------- 1 | //! Contains defintions for OCaml tags 2 | 3 | /// Used to store OCaml value tags, which are used to determine the underlying type of values 4 | pub type Tag = u8; 5 | 6 | pub const FORWARD: Tag = 250; 7 | pub const INFIX: Tag = 249; 8 | pub const OBJECT: Tag = 248; 9 | pub const CLOSURE: Tag = 247; 10 | pub const LAZY: Tag = 246; 11 | pub const ABSTRACT: Tag = 251; 12 | pub const NO_SCAN: Tag = 251; 13 | pub const STRING: Tag = 252; 14 | pub const DOUBLE: Tag = 253; 15 | pub const DOUBLE_ARRAY: Tag = 254; 16 | pub const CUSTOM: Tag = 255; 17 | -------------------------------------------------------------------------------- /test/.cargo/config.toml: -------------------------------------------------------------------------------- 1 | [build] 2 | rustflags = ["-C", "link-args=-Wl,-undefined,dynamic_lookup"] 3 | -------------------------------------------------------------------------------- /test/Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "ocamlrs_test_stubs" 3 | version = "0.1.0" 4 | edition = "2021" 5 | 6 | [lib] 7 | crate-type = ["staticlib", "cdylib"] 8 | 9 | [dependencies] 10 | ocaml-sys = { path = "../sys" } 11 | ocaml = { path = "..", features = ["bigarray-ext"] } 12 | ndarray = "^0.16.1" 13 | 14 | [build-dependencies] 15 | ocaml-build = { path = "../build" } 16 | 17 | -------------------------------------------------------------------------------- /test/build.rs: -------------------------------------------------------------------------------- 1 | fn main() -> std::io::Result<()> { 2 | ocaml_build::Sigs::new("src/rust.ml").generate() 3 | } 4 | -------------------------------------------------------------------------------- /test/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name ocamlrs-test) 3 | -------------------------------------------------------------------------------- /test/ocamlrs-test.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "zachshipko@gmail.com" 3 | authors: ["Zach Shipko"] 4 | license: "ISC" 5 | homepage: "https://github.com/zshipko/ocaml-rs" 6 | bug-reports: "https://github.com/zshipko/ocaml-rs/issues" 7 | dev-repo: "git+https://github.com/zshipko/ocaml-rs.git" 8 | 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ["dune" "exec" "bin/main.exe"] {with-test} 12 | ] 13 | 14 | depends: [ 15 | "ocaml" {>= "4.06.0"} 16 | "dune" {>= "2.0.0"} 17 | "ppx_inline_test" {with-test} 18 | "bechamel-notty" {with-test} 19 | "notty" {with-test} 20 | "conf-rust-2018" 21 | ] 22 | synopsis: """ 23 | Example program using ocaml-rs 24 | """ 25 | 26 | -------------------------------------------------------------------------------- /test/src/bench.ml: -------------------------------------------------------------------------------- 1 | open Bechamel 2 | open Toolkit 3 | open Ocamlrs_test 4 | 5 | let test_func = 6 | Test.make ~name:"func" 7 | (Staged.stage Runtime.func) 8 | 9 | let test_native_func = 10 | Test.make ~name:"native_func" 11 | (Staged.stage Runtime.func) 12 | 13 | 14 | let tests = (Test.make_grouped ~name:"call overhead" ~fmt:"%s %s" [ test_func; test_native_func ]) 15 | 16 | let cfg = Benchmark.cfg ~limit:2000 ~quota:(Time.second 5.0) ~kde:(Some 1000) () 17 | 18 | let benchmark () = 19 | let ols = 20 | Analyze.ols ~bootstrap:0 ~r_square:true ~predictors:Measure.[| run |] in 21 | let instances = Instance.[ monotonic_clock ] in 22 | let raw_results = Benchmark.all cfg instances tests in 23 | let results = 24 | List.map (fun instance -> Analyze.all ols instance raw_results) instances 25 | in 26 | let results = Analyze.merge ols instances results in 27 | (results, raw_results) 28 | 29 | let () = 30 | List.iter 31 | (fun v -> Bechamel_notty.Unit.add v (Measure.unit v)) 32 | Instance.[ minor_allocated; major_allocated; monotonic_clock ] 33 | 34 | let img (window, results) = 35 | Bechamel_notty.Multiple.image_of_ols_results ~rect:window 36 | ~predictor:Measure.run results 37 | 38 | open Notty_unix 39 | 40 | let () = 41 | let window = 42 | match winsize Unix.stdout with 43 | | Some (w, h) -> { Bechamel_notty.w; h } 44 | | None -> { Bechamel_notty.w = 80; h = 1 } in 45 | let results, _ = benchmark () in 46 | print_endline "\nBenchmarks"; 47 | img (window, results) |> eol |> output_image 48 | -------------------------------------------------------------------------------- /test/src/callbacks.ml: -------------------------------------------------------------------------------- 1 | open Rust 2 | 3 | let%test "apply1 float" = Util.check_leaks (fun () -> apply1 (( +. ) 1.0) 2.5 = 3.5) 4 | let%test "apply3 float" = Util.check_leaks (fun () -> apply3 (( +. ) 1.0) (-1.0) = 2.0) 5 | let%test "apply3 string" = Util.check_leaks (fun () -> apply3 (( ^ ) "A") "A" = "AAAA") 6 | let%test "apply3 apply1" = Util.check_leaks (fun () -> apply3 (apply1 (( +. ) 1.0)) 1000.0 = 1003.0) 7 | 8 | let%test "apply1 failure" = 9 | (*TODO: figure out why this is failing leak check*) 10 | (*Util.check_leaks (fun () ->*) 11 | try apply1 (fun _ -> failwith "Testing") true 12 | with 13 | | Failure x -> let () = Util.gc () in x = "Testing" 14 | | _ -> false 15 | 16 | 17 | let%test "apply3 invalid_arg" = 18 | (*TODO: figure out why this is failing leak check*) 19 | (*Util.check_leaks (fun () ->*) 20 | try apply3 (fun _ -> invalid_arg "Testing") true 21 | with 22 | | Invalid_argument x -> let () = Util.gc () in x = "Testing" 23 | | _ -> false 24 | 25 | let%test "apply range 1" = 26 | Util.check_leaks (fun () -> apply_range (List.map (fun a -> let () = Util.gc () in a + 1)) 0 10 = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]) 27 | -------------------------------------------------------------------------------- /test/src/callbacks.rs: -------------------------------------------------------------------------------- 1 | use ocaml::{Error, Value}; 2 | 3 | #[ocaml::func] 4 | #[ocaml::sig("('a -> 'b) -> 'a -> 'b")] 5 | pub unsafe fn apply1(f: Value, x: Value) -> Result { 6 | let f = ocaml::function!(f, (a: Value) -> Value); 7 | f(gc, &x) 8 | } 9 | 10 | #[ocaml::func] 11 | #[ocaml::sig("('a -> 'b) -> 'a -> 'b")] 12 | pub unsafe fn apply3(f: Value, x: Value) -> Result { 13 | let f = ocaml::function!(f, (a: Value) -> Value); 14 | let a = f(gc, &x)?; 15 | let b = f(gc, &a)?; 16 | f(gc, &b) 17 | } 18 | 19 | #[ocaml::func] 20 | #[ocaml::sig("(int list -> 'a) -> int -> int -> 'a")] 21 | pub unsafe fn apply_range(f: Value, start: ocaml::Int, stop: ocaml::Int) -> Result { 22 | let mut l = ocaml::List::empty(); 23 | for i in start..stop { 24 | let v = stop - 1 - i; 25 | l = l.add(gc, &v) 26 | } 27 | 28 | let f = ocaml::function!(f, (a: ocaml::List) -> Value); 29 | f(gc, &l) 30 | } 31 | -------------------------------------------------------------------------------- /test/src/conv.ml: -------------------------------------------------------------------------------- 1 | open Rust 2 | 3 | let%test "enum1 empty" = Util.check_leaks (fun () -> (enum1_empty () = Empty)) 4 | let%test "enum1 first 1" = Util.check_leaks (fun () -> (enum1_first 1 = First 1)) 5 | let%test "enum1 first 9999" = Util.check_leaks (fun () -> (enum1_first 9999 = First 9999)) 6 | 7 | let test_second s = 8 | let second = enum1_make_second s in 9 | let () = Util.gc () in 10 | let value = enum1_get_second_value second in 11 | let () = Util.gc () in 12 | match value with 13 | | Some a -> Some a.(0) 14 | | None -> None 15 | 16 | 17 | let%test "enum1 second" = Util.check_leaks (fun () -> (test_second "testing" = Some "testing")) 18 | 19 | let%test "enum1 is empty 0" = Util.check_leaks (fun () -> (enum1_is_empty Empty = true)) 20 | let%test "enum1 is empty 1" = Util.check_leaks (fun () -> enum1_is_empty (First 1) = false) 21 | 22 | let%test "struct1 c" = Util.check_leaks (fun () -> 23 | let s = struct1_empty () in 24 | let () = Util.gc () in 25 | let s = struct1_set_c s "testing" in 26 | Util.gc (); 27 | struct1_get_c s = Some "testing" && s.c = Some "testing" 28 | ) 29 | 30 | let%test "struct1 c (make)" = Util.check_leaks (fun () -> 31 | let s = make_struct1 1 2.0 (Some "testing") None in 32 | Util.gc (); 33 | struct1_get_c s = Some "testing" 34 | ) 35 | 36 | let%test "struct1 c (make) 2" = Util.check_leaks (fun () -> 37 | let s = make_struct1 1 2.0 None None in 38 | Util.gc (); 39 | struct1_get_c s = None 40 | ) 41 | 42 | let%test "struct1 c" = Util.check_leaks (fun () -> 43 | let s = {a = 1; b = 2.0; c = Some "testing"; d = None} in 44 | Util.gc (); 45 | struct1_get_c s = Some "testing" && struct1_get_c s = s.c 46 | ) 47 | 48 | let%test "struct1 d" = Util.check_leaks (fun () -> 49 | let s = {a = 1; b = 2.0; c = None; d = Some [| "abc"; "123" |]} in 50 | Util.gc (); 51 | struct1_get_d s = Some [| "abc"; "123" |] && struct1_get_d s = s.d 52 | ) 53 | 54 | let%test "struct1 d 2" = Util.check_leaks (fun () -> ( 55 | let s = make_struct1 1 2.0 None (Some [| "abc"; "123" |]) in 56 | Util.gc (); 57 | struct1_get_d s = Some [| "abc"; "123" |] && struct1_get_d s = s.d) 58 | ) 59 | 60 | let%test "string (non-copy)" = Util.check_leaks (fun () -> ( 61 | let a = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" in 62 | Util.gc (); 63 | string_non_copying a = a 64 | )) 65 | 66 | 67 | let%test "direct slice 1" = Util.check_leaks (fun () -> ( 68 | let arr = [| 1L; 2L; 3L |] in 69 | Util.gc (); 70 | direct_slice arr = 6L 71 | )) 72 | 73 | let%test "deep clone 1" = Util.check_leaks (fun () -> ( 74 | let a = [1; 2; 3; 4; 5] in 75 | Util.gc (); 76 | deep_clone a = a 77 | )) 78 | 79 | let%test "get-pair-vec" = Util.check_leaks (fun () -> ( 80 | pair_vec () = [| "foo", 1; "bar", 2 |] 81 | )) 82 | 83 | let%test "get-string-array" = Util.check_leaks (fun () -> ( 84 | let _foo = string_array () in 85 | true 86 | )) 87 | 88 | let%test "get-array-conv" = Util.check_leaks (fun () -> ( 89 | let a = Bytes.of_string "\x01\x02\x03\x04\x05" in 90 | let expected_b = Bytes.of_string "\x01\x02\x03\x04\x05\x0f\xff" in 91 | array_conv a = expected_b 92 | )) 93 | 94 | let%test "result" = Util.check_leaks (fun () -> ( 95 | let ok = result_ok "123" in 96 | let err = result_error (`Test 123) in 97 | result_get_ok ok = Some "123" && result_get_error err = Some (`Test 123) && result_get_ok err = None && result_get_error ok = None 98 | )) 99 | 100 | let%test "all float struct" = Util.check_leaks (fun() -> 101 | let s = Rust.{float_a = 1.0; float_b = 2.0} in 102 | let t = Rust.all_float_struct_inc_both s in 103 | t.float_a = 2.0 && t.float_b = 3.0) 104 | 105 | let%test "floatarray_t" = Util.check_leaks (fun () -> 106 | let a = Rust.{fa = Float.Array.of_list [ 1.0; 2.0; 3.0; ]} in 107 | let b = Rust.float_array_t_inner a in 108 | a.fa = b) 109 | 110 | (* Tests that arrays generated in rust can be indexed into from ocaml *) 111 | let%test "index into int array" = Util.check_leaks (fun () -> 112 | let arr = Rust.make_int32_array_012 () in 113 | List.for_all (fun i -> Int32.to_int (Array.get arr i) = i) [0; 1; 2]) 114 | 115 | let%test "index float array f32" = Util.check_leaks (fun () -> 116 | let arr = Rust.make_float_array_f32_012 () in 117 | List.for_all (fun i -> Array.get arr i = Float.of_int i) [0; 1; 2]) 118 | 119 | let%test "index floatarray f32" = Util.check_leaks (fun () -> 120 | let arr = Rust.make_floatarray_f32_012 () in 121 | List.for_all (fun i -> Float.Array.get arr i = Float.of_int i) [0; 1; 2]) 122 | 123 | let%test "index float array f64" = Util.check_leaks (fun () -> 124 | let arr = Rust.make_float_array_f64_012 () in 125 | List.for_all (fun i -> Array.get arr i = Float.of_int i) [0; 1; 2]) 126 | 127 | let%test "index floatarray f64" = Util.check_leaks (fun () -> 128 | let arr = Rust.make_floatarray_f64_012 () in 129 | List.for_all (fun i -> Float.Array.get arr i = Float.of_int i) [0; 1; 2]) 130 | -------------------------------------------------------------------------------- /test/src/conv.rs: -------------------------------------------------------------------------------- 1 | use ocaml::{FromValue, ToValue}; 2 | 3 | #[derive(ToValue, FromValue)] 4 | #[ocaml::sig("Empty | First of int | Second of string array")] 5 | enum Enum1 { 6 | Empty, 7 | First(ocaml::Int), 8 | Second(ocaml::Array), 9 | } 10 | 11 | #[ocaml::func] 12 | #[ocaml::sig("unit -> enum1")] 13 | pub fn enum1_empty() -> Enum1 { 14 | Enum1::Empty 15 | } 16 | 17 | #[ocaml::func] 18 | #[ocaml::sig("int -> enum1")] 19 | pub unsafe fn enum1_first(i: ocaml::Int) -> Enum1 { 20 | Enum1::First(i) 21 | } 22 | 23 | #[ocaml::func(test)] 24 | #[ocaml::sig("string -> enum1")] 25 | pub unsafe fn enum1_make_second(s: String) -> Enum1 { 26 | let mut arr = ocaml::Array::alloc(1); 27 | let _ = arr.set(test, 0, &s); 28 | Enum1::Second(arr) 29 | } 30 | 31 | #[ocaml::func] 32 | #[ocaml::sig("enum1 -> string array option")] 33 | pub fn enum1_get_second_value(e: Enum1) -> Option> { 34 | match e { 35 | Enum1::Second(x) => Some(x), 36 | Enum1::Empty | Enum1::First(_) => None, 37 | } 38 | } 39 | 40 | #[ocaml::func] 41 | #[ocaml::sig("enum1 -> bool")] 42 | pub fn enum1_is_empty(e: Enum1) -> bool { 43 | matches!(e, Enum1::Empty) 44 | } 45 | 46 | #[derive(ToValue, FromValue, Default)] 47 | #[ocaml::sig("{a: int; b: float; mutable c: string option; d: string array option;}")] 48 | struct Struct1 { 49 | a: ocaml::Int, 50 | b: ocaml::Float, 51 | c: Option, 52 | d: Option>, 53 | } 54 | 55 | #[ocaml::func] 56 | #[ocaml::sig("unit -> struct1")] 57 | pub fn struct1_empty() -> Struct1 { 58 | Struct1::default() 59 | } 60 | 61 | #[ocaml::func] 62 | #[ocaml::sig("struct1 -> string option")] 63 | pub fn struct1_get_c(s: Struct1) -> Option { 64 | s.c 65 | } 66 | 67 | #[ocaml::func] 68 | #[ocaml::sig("struct1 -> string array option")] 69 | pub fn struct1_get_d(s: Struct1) -> Option> { 70 | s.d 71 | } 72 | 73 | #[ocaml::func] 74 | #[ocaml::sig("struct1 -> string -> struct1")] 75 | pub fn struct1_set_c(mut s: Struct1, v: String) -> Struct1 { 76 | s.c = Some(v); 77 | s 78 | } 79 | 80 | #[ocaml::func] 81 | #[ocaml::sig("int -> float -> string option -> string array option -> struct1")] 82 | #[allow(clippy::unnecessary_wraps)] 83 | pub unsafe fn make_struct1( 84 | a: ocaml::Int, 85 | b: ocaml::Float, 86 | c: Option, 87 | d: Option>, 88 | ) -> Result { 89 | Ok(Struct1 { a, b, c, d }) 90 | } 91 | 92 | #[ocaml::func] 93 | #[ocaml::sig("string -> string")] 94 | pub unsafe fn string_non_copying(s: ocaml::Value) -> ocaml::Value { 95 | s 96 | } 97 | 98 | #[ocaml::func] 99 | #[ocaml::sig("int64 array -> int64")] 100 | pub unsafe fn direct_slice(data: &[ocaml::Raw]) -> i64 { 101 | let mut total = 0; 102 | for i in data { 103 | total += ocaml::Value::new(*i).int64_val(); 104 | } 105 | total 106 | } 107 | 108 | #[ocaml::func] 109 | #[ocaml::sig("'a -> 'a")] 110 | pub unsafe fn deep_clone(a: ocaml::Value) -> ocaml::Value { 111 | let b = a.deep_clone_to_rust(); 112 | b.deep_clone_to_ocaml() 113 | } 114 | 115 | #[ocaml::func] 116 | #[ocaml::sig("unit -> (string * int) array")] 117 | pub fn pair_vec() -> ocaml::Value { 118 | vec![("foo", 1), ("bar", 2isize)].to_value(gc) 119 | } 120 | 121 | #[ocaml::native_func] 122 | #[ocaml::sig("unit -> string array")] 123 | pub fn string_array() -> ocaml::Value { 124 | let mut v = vec![]; 125 | for i in 1..10000000 { 126 | v.push(format!("foo {}", i)); 127 | } 128 | v.to_value(gc) 129 | } 130 | 131 | #[ocaml::func] 132 | #[ocaml::sig("bytes -> bytes")] 133 | #[allow(clippy::manual_memcpy)] 134 | pub fn array_conv(a: [u8; 5]) -> [u8; 7] { 135 | let mut b = [0u8; 7]; 136 | for i in 0..5 { 137 | b[i] = a[i]; 138 | b[5] += a[i]; 139 | } 140 | b[6] = 255; 141 | b 142 | } 143 | 144 | #[ocaml::func] 145 | #[ocaml::sig("'a -> ('a, 'b) result")] 146 | pub fn result_ok(x: ocaml::Value) -> Result { 147 | Ok(x) 148 | } 149 | 150 | #[ocaml::func] 151 | #[ocaml::sig("'a -> ('b, 'a) result")] 152 | pub fn result_error(x: ocaml::Value) -> Result { 153 | Err(x) 154 | } 155 | 156 | #[ocaml::func] 157 | #[ocaml::sig("('a, 'b) result -> 'a option")] 158 | pub fn result_get_ok(x: Result) -> Option { 159 | match x { 160 | Ok(x) => Some(x), 161 | Err(_) => None, 162 | } 163 | } 164 | 165 | #[ocaml::func] 166 | #[ocaml::sig("('a, 'b) result -> 'b option")] 167 | pub fn result_get_error(x: Result) -> Option { 168 | match x { 169 | Ok(_) => None, 170 | Err(x) => Some(x), 171 | } 172 | } 173 | 174 | #[derive(ocaml::ToValue, ocaml::FromValue, Debug)] 175 | #[ocaml::sig("{float_a: float; float_b: float}")] 176 | pub struct AllFloatStruct { 177 | float_a: ocaml::Float, 178 | float_b: ocaml::Float, 179 | } 180 | 181 | #[ocaml::func] 182 | #[ocaml::sig("all_float_struct -> all_float_struct")] 183 | pub fn all_float_struct_inc_both(mut t: AllFloatStruct) -> AllFloatStruct { 184 | t.float_a += 1.0; 185 | t.float_b += 1.0; 186 | t 187 | } 188 | 189 | #[derive(ocaml::ToValue, ocaml::FromValue)] 190 | #[ocaml::sig("{fa: floatarray} [@@unboxed]")] 191 | #[unboxed] 192 | pub struct FloatArrayT { 193 | arr: Vec, 194 | } 195 | 196 | #[ocaml::func] 197 | #[ocaml::sig("float_array_t -> floatarray")] 198 | pub fn float_array_t_inner(f: FloatArrayT) -> Vec { 199 | f.arr 200 | } 201 | 202 | #[ocaml::func] 203 | #[ocaml::sig("unit -> int32 array")] 204 | pub fn make_int32_array_012() -> Vec { 205 | println!("make_int32_012"); 206 | vec![0, 1, 2] 207 | } 208 | 209 | #[ocaml::func] 210 | #[ocaml::sig("unit -> float array")] 211 | pub fn make_float_array_f32_012() -> Vec { 212 | vec![0.0, 1.0, 2.0] 213 | } 214 | 215 | #[ocaml::func] 216 | #[ocaml::sig("unit -> floatarray")] 217 | pub fn make_floatarray_f32_012() -> Vec { 218 | vec![0.0, 1.0, 2.0] 219 | } 220 | 221 | #[ocaml::func] 222 | #[ocaml::sig("unit -> float array")] 223 | pub fn make_float_array_f64_012() -> Vec { 224 | vec![0.0, 1.0, 2.0] 225 | } 226 | 227 | #[ocaml::func] 228 | #[ocaml::sig("unit -> floatarray")] 229 | pub fn make_floatarray_f64_012() -> Vec { 230 | vec![0.0, 1.0, 2.0] 231 | } 232 | -------------------------------------------------------------------------------- /test/src/custom.ml: -------------------------------------------------------------------------------- 1 | open Rust 2 | 3 | let%test "testing compare 1" = Util.check_leaks (fun () -> testing_alloc 0L <> testing_alloc 1L) 4 | let%test "testing compare 2" = Util.check_leaks (fun () -> testing_alloc 99L = testing_alloc 99L) 5 | let%test "testing set c" = Util.check_leaks (fun () -> ( 6 | let t = testing_alloc 1L in 7 | let () = Util.gc () in 8 | testing_set_a t 3.14; 9 | Util.gc (); 10 | testing_set_c t "FOOBAR"; 11 | Util.gc (); 12 | let (a, b, c) = testing_get_values t in 13 | Util.gc (); 14 | a = 3.14 && b = 1L && c = "FOOBAR" 15 | )) 16 | 17 | let%test "testing callback 1" = Util.check_leaks (fun () -> ( 18 | let c = testing_callback_alloc (fun x -> float_of_int x *. 2.) in 19 | Util.gc (); 20 | testing_callback_call c 1 = 2.0) 21 | ) 22 | 23 | let%test "testing callback 2" = Util.check_leaks (fun () -> ( 24 | let c = testing_callback_alloc (fun x -> 25 | let () = Unix.sleep 2 in 26 | sin (float_of_int x)) in 27 | Util.gc (); 28 | testing_callback_call c 5 = sin 5.0) 29 | ) 30 | 31 | let%test "testing abstract" = Util.check_leaks (fun () -> ( 32 | let a = open_in "./custom.ml" in 33 | let len = in_channel_length a in 34 | let s = really_input_string a len in 35 | let () = close_in a in 36 | assert (String.length s = len); 37 | let f = file_open "./custom.ml" in 38 | let s' = file_read f in 39 | let () = file_close f in 40 | s = s' 41 | )) 42 | -------------------------------------------------------------------------------- /test/src/custom.rs: -------------------------------------------------------------------------------- 1 | use ocaml::Raw; 2 | 3 | #[ocaml::sig] 4 | struct Testing { 5 | a: ocaml::Float, 6 | b: i64, 7 | c: String, 8 | } 9 | 10 | unsafe extern "C" fn testing_compare(a: Raw, b: Raw) -> i32 { 11 | let t0 = a.as_pointer::(); 12 | let t1 = b.as_pointer::(); 13 | match (t0.as_ref().b, t1.as_ref().b) { 14 | (x, y) if x == y => 0, 15 | (x, y) if x < y => -1, 16 | _ => 1, 17 | } 18 | } 19 | 20 | ocaml::custom!(Testing { 21 | compare: testing_compare, 22 | }); 23 | 24 | #[ocaml::func] 25 | #[ocaml::sig("int64 -> testing")] 26 | pub fn testing_alloc(b: i64) -> ocaml::Pointer { 27 | Testing { 28 | a: 0.0, 29 | b, 30 | c: String::new(), 31 | } 32 | .into() 33 | } 34 | 35 | #[ocaml::func] 36 | #[ocaml::sig("testing -> string -> unit")] 37 | pub fn testing_set_c(testing: &mut Testing, v: String) { 38 | testing.c = v; 39 | } 40 | 41 | #[ocaml::func] 42 | #[ocaml::sig("testing -> float -> unit")] 43 | pub fn testing_set_a(mut testing: ocaml::Pointer, v: ocaml::Float) { 44 | testing.as_mut().a = v; 45 | } 46 | 47 | #[ocaml::func] 48 | #[ocaml::sig("testing -> (float * int64 * string)")] 49 | pub fn testing_get_values(t: &Testing) -> (ocaml::Float, i64, String) { 50 | (t.a, t.b, t.c.clone()) 51 | } 52 | 53 | #[ocaml::sig] 54 | struct TestingCallback { 55 | func: ocaml::Value, 56 | } 57 | 58 | unsafe extern "C" fn testing_callback_finalize(a: ocaml::Raw) { 59 | let t0 = a.as_pointer::(); 60 | t0.drop_in_place(); 61 | } 62 | 63 | ocaml::custom_finalize!(TestingCallback, testing_callback_finalize); 64 | 65 | #[ocaml::func] 66 | #[ocaml::sig("(int -> float) -> testing_callback")] 67 | pub fn testing_callback_alloc(func: ocaml::Value) -> ocaml::Pointer { 68 | TestingCallback { func }.into() 69 | } 70 | 71 | #[ocaml::func] 72 | #[ocaml::sig("testing_callback -> int -> float")] 73 | pub unsafe fn testing_callback_call( 74 | t: ocaml::Pointer, 75 | x: ocaml::Int, 76 | ) -> Result { 77 | let f = ocaml::function!(t.as_ref().func, (x: ocaml::Int) -> ocaml::Float); 78 | f(gc, &x) 79 | } 80 | 81 | // Abstract 82 | 83 | use std::io::Read; 84 | 85 | #[ocaml::sig] 86 | type File = std::fs::File; 87 | 88 | #[ocaml::func] 89 | #[ocaml::sig("string -> file")] 90 | pub fn file_open(filename: &str) -> Result, ocaml::Error> { 91 | let f = File::open(filename)?; 92 | Ok(ocaml::Pointer::alloc(f)) 93 | } 94 | 95 | #[ocaml::func] 96 | #[ocaml::sig("file -> string")] 97 | pub fn file_read(mut file: ocaml::Pointer) -> Result { 98 | let mut s = String::new(); 99 | let file = file.as_mut(); 100 | file.read_to_string(&mut s)?; 101 | Ok(s) 102 | } 103 | 104 | #[ocaml::func] 105 | #[ocaml::sig("file -> unit")] 106 | pub unsafe fn file_close(file: ocaml::Pointer) { 107 | file.drop_in_place(); 108 | } 109 | -------------------------------------------------------------------------------- /test/src/dune: -------------------------------------------------------------------------------- 1 | (include_subdirs unqualified) 2 | 3 | (rule 4 | (deps 5 | (glob_files *.rs)) 6 | (targets libocamlrs_test_stubs.a dllocamlrs_test_stubs.so) 7 | (action 8 | (progn 9 | ; Build the Rust code 10 | (run cargo build --target-dir %{project_root}/../../target --release) 11 | ; This is needed to support Linux and macOS shared libraries 12 | (run sh -c 13 | "mv %{project_root}/../../target/release/libocamlrs_test_stubs.so ./dllocamlrs_test_stubs.so 2> /dev/null || mv %{project_root}/../../target/release/libocamlrs_test_stubs.dylib ./dllocamlrs_test_stubs.so") 14 | ; Copy over the static library too 15 | (run mv %{project_root}/../../target/release/libocamlrs_test_stubs.a 16 | libocamlrs_test_stubs.a)))) 17 | 18 | (library 19 | (name ocamlrs_test) 20 | (public_name ocamlrs-test) 21 | (modules conv types callbacks runtime custom util rust) 22 | (inline_tests) 23 | (preprocess 24 | (pps ppx_inline_test)) 25 | (libraries unix) 26 | ; Link the Rust library 27 | (foreign_archives ocamlrs_test_stubs) 28 | (c_library_flags 29 | (-lpthread -lc -lm))) 30 | 31 | (executable 32 | (name bench) 33 | (public_name bench) 34 | (package ocamlrs-test) 35 | (libraries notty unix notty.unix bechamel-notty ocamlrs_test) 36 | (modules bench) 37 | (preprocess no_preprocessing)) 38 | -------------------------------------------------------------------------------- /test/src/lib.rs: -------------------------------------------------------------------------------- 1 | pub mod callbacks; 2 | pub mod conv; 3 | pub mod custom; 4 | pub mod runtime; 5 | pub mod types; 6 | -------------------------------------------------------------------------------- /test/src/runtime.ml: -------------------------------------------------------------------------------- 1 | 2 | open Rust 3 | 4 | (* Unboxed *) 5 | external unboxed_float_avg: float -> float -> float = "unboxed_float_avg_bytecode" "unboxed_float_avg" [@@unboxed] [@@noalloc] 6 | 7 | let%test "unboxed float avg 0" = Util.check_leaks (fun () -> let a = unboxed_float_avg 0.0 0.0 in Util.gc (); a = 0.0) 8 | let%test "unboxed float avg" = Util.check_leaks (fun () -> unboxed_float_avg 100.0 300.0 = 200.0) 9 | let%test "more than 5 params 0" = Util.check_leaks (fun () -> let a = more_than_five_params 0.0 0.0 0.0 0.0 0.0 0.0 0.0 in Util.gc (); a = 0.0) 10 | let%test "more than 5 params" = Util.check_leaks (fun () -> let a = more_than_five_params 1.0 1.0 1.0 1.0 1.0 1.0 1.0 in Util.gc (); a = 7.0) 11 | let%test "too many arguments" = Util.check_leaks (fun () -> ( 12 | mutable_parameter_with_more_than_five_arguments true true 0L 0L None None; 13 | true) 14 | ) 15 | 16 | (* Exceptions *) 17 | 18 | exception Exc of float 19 | 20 | exception Rust of string 21 | 22 | let () = Callback.register_exception "Exc" (Exc 0.0) 23 | 24 | let%test "raise exc" = try 25 | raise_exc 10.; true 26 | with Exc x -> x = 10. 27 | 28 | let%test "raise failure" = try 29 | raise_failure (); true 30 | with Failure e -> let () = Util.gc () in e = "An error" 31 | 32 | (* Hash variant *) 33 | type hash_variant = [ 34 | | `Abc of int 35 | | `Def of float 36 | ] 37 | 38 | let%test "hash variant `Abc" = Util.check_leaks (fun () -> let a = hash_variant_abc 123 in Util.gc (); a = `Abc 123) 39 | let%test "hash variant `Def" = Util.check_leaks (fun () -> let a = hash_variant_def 9. in Util.gc (); a = `Def 9.) 40 | 41 | let%test "test panic" = Util.check_leaks (fun () -> try 42 | let _ = test_panic () in 43 | false 44 | with 45 | | Failure s -> begin 46 | Util.gc (); 47 | s = "XXX" 48 | end 49 | | _ -> false) 50 | 51 | 52 | let () = Callback.register "call_named" (fun x -> x *. 2.) 53 | 54 | let%test "test call named" = Util.check_leaks (fun () -> 55 | let x = test_call_named 2.0 in 56 | Util.gc (); 57 | x = 4.0 58 | ) 59 | 60 | 61 | 62 | let%test "exn" = Util.check_leaks (fun () -> ( 63 | let str = exn_to_string (Invalid_argument "test") in 64 | str = "Invalid_argument(\"test\")" 65 | )) 66 | 67 | 68 | let%test "GC" = 69 | Random.init 0; 70 | let test f = 71 | let i = Random.int 1337 in 72 | let s = string_of_int i in 73 | f(); 74 | s = string_of_int i 75 | in 76 | List.for_all test [gc_minor; gc_major; gc_full_major; gc_compact] 77 | -------------------------------------------------------------------------------- /test/src/runtime.rs: -------------------------------------------------------------------------------- 1 | use ocaml::{ToValue, Value}; 2 | 3 | #[no_mangle] 4 | pub extern "C" fn unboxed_float_avg(a: f64, b: f64) -> f64 { 5 | (a + b) / 2.0 6 | } 7 | 8 | #[ocaml::bytecode_func] 9 | pub fn unboxed_float_avg_bytecode(a: f64, b: f64) -> f64 { 10 | unboxed_float_avg(a, b) 11 | } 12 | 13 | #[ocaml::func] 14 | #[ocaml::sig("float -> float -> float -> float -> float -> float -> float -> float")] 15 | #[allow(clippy::too_many_arguments)] 16 | pub unsafe fn more_than_five_params( 17 | mut a: ocaml::Float, 18 | mut b: ocaml::Float, 19 | c: ocaml::Float, 20 | d: ocaml::Float, 21 | e: ocaml::Float, 22 | f: ocaml::Float, 23 | g: ocaml::Float, 24 | ) -> ocaml::Float { 25 | a -= 1.0; 26 | b += 1.0; 27 | a + b + c + d + e + f + g 28 | } 29 | 30 | // See: https://github.com/zshipko/ocaml-rs/issues/29 31 | #[ocaml::func] 32 | #[ocaml::sig("bool -> bool -> int64 -> int64 -> int64 option -> int32 option -> unit")] 33 | pub fn mutable_parameter_with_more_than_five_arguments( 34 | mut net: bool, 35 | data: bool, 36 | batch_size: u64, 37 | epochs: u64, 38 | print_loss: Option, 39 | _metrics: Option, 40 | ) { 41 | let _ = net; 42 | let _ = data; 43 | let _ = batch_size; 44 | let _ = epochs; 45 | let _ = print_loss; 46 | net = false; 47 | let _ = net; 48 | } 49 | 50 | #[ocaml::func] 51 | #[ocaml::sig("float -> unit")] 52 | pub fn raise_exc(x: ocaml::Float) -> Result<(), ocaml::Error> { 53 | ocaml::Error::raise_with_arg("Exc", x.to_value(gc)) 54 | } 55 | 56 | #[ocaml::func] 57 | #[ocaml::sig("unit -> unit")] 58 | pub fn raise_failure() -> Result<(), ocaml::Error> { 59 | ocaml::Error::failwith("An error") 60 | } 61 | 62 | #[ocaml::func] 63 | #[ocaml::sig("int -> [`Abc of int]")] 64 | pub unsafe fn hash_variant_abc(i: ocaml::Int) -> Value { 65 | Value::hash_variant(gc, "Abc", Some(Value::int(i))) 66 | } 67 | 68 | #[ocaml::func] 69 | #[ocaml::sig("float -> [`Def of float]")] 70 | pub unsafe fn hash_variant_def(i: ocaml::Float) -> Value { 71 | let f = Some(Value::double(i)); 72 | Value::hash_variant(gc, "Def", f) 73 | } 74 | 75 | #[ocaml::func] 76 | #[ocaml::sig("unit -> int")] 77 | pub fn test_panic() -> ocaml::Int { 78 | panic!("XXX") 79 | } 80 | 81 | ocaml::import! { 82 | fn call_named(g: ocaml::Float) -> ocaml::Float; 83 | } 84 | 85 | #[ocaml::func] 86 | #[ocaml::sig("float -> float")] 87 | pub unsafe fn test_call_named(g: f64) -> Result { 88 | call_named(gc, g) 89 | } 90 | 91 | #[ocaml::func] 92 | #[ocaml::sig("unit -> unit")] 93 | pub unsafe fn bench_func() {} 94 | 95 | #[ocaml::native_func] 96 | #[ocaml::sig("unit -> unit")] 97 | pub unsafe fn bench_native_func() -> ocaml::Value { 98 | ocaml::Value::unit() 99 | } 100 | 101 | #[ocaml::func] 102 | #[ocaml::sig("exn -> string")] 103 | pub unsafe fn exn_to_string(exn: ocaml::Value) -> String { 104 | exn.exception_to_string().unwrap() 105 | } 106 | 107 | #[ocaml::func] 108 | #[ocaml::sig("unit -> unit")] 109 | pub unsafe fn gc_minor() { 110 | ocaml::runtime::gc_minor(); 111 | } 112 | 113 | #[ocaml::func] 114 | #[ocaml::sig("unit -> unit")] 115 | pub unsafe fn gc_major() { 116 | ocaml::runtime::gc_major(); 117 | } 118 | 119 | #[ocaml::func] 120 | #[ocaml::sig("unit -> unit")] 121 | pub unsafe fn gc_full_major() { 122 | ocaml::runtime::gc_full_major(); 123 | } 124 | 125 | #[ocaml::func] 126 | #[ocaml::sig("unit -> unit")] 127 | pub unsafe fn gc_compact() { 128 | ocaml::runtime::gc_compact(); 129 | } 130 | -------------------------------------------------------------------------------- /test/src/rust.ml: -------------------------------------------------------------------------------- 1 | (* Generated by ocaml-rs *) 2 | 3 | open! Bigarray 4 | 5 | (* file: callbacks.rs *) 6 | 7 | external apply1: ('a -> 'b) -> 'a -> 'b = "apply1" 8 | external apply3: ('a -> 'b) -> 'a -> 'b = "apply3" 9 | external apply_range: (int list -> 'a) -> int -> int -> 'a = "apply_range" 10 | 11 | (* file: conv.rs *) 12 | 13 | type enum1 = Empty | First of int | Second of string array 14 | type struct1 = {a: int; b: float; mutable c: string option; d: string array option;} 15 | type all_float_struct = {float_a: float; float_b: float} 16 | type float_array_t = {fa: floatarray} [@@unboxed] 17 | external enum1_empty: unit -> enum1 = "enum1_empty" 18 | external enum1_first: int -> enum1 = "enum1_first" 19 | external enum1_make_second: string -> enum1 = "enum1_make_second" 20 | external enum1_get_second_value: enum1 -> string array option = "enum1_get_second_value" 21 | external enum1_is_empty: enum1 -> bool = "enum1_is_empty" 22 | external struct1_empty: unit -> struct1 = "struct1_empty" 23 | external struct1_get_c: struct1 -> string option = "struct1_get_c" 24 | external struct1_get_d: struct1 -> string array option = "struct1_get_d" 25 | external struct1_set_c: struct1 -> string -> struct1 = "struct1_set_c" 26 | external make_struct1: int -> float -> string option -> string array option -> struct1 = "make_struct1" 27 | external string_non_copying: string -> string = "string_non_copying" 28 | external direct_slice: int64 array -> int64 = "direct_slice" 29 | external deep_clone: 'a -> 'a = "deep_clone" 30 | external pair_vec: unit -> (string * int) array = "pair_vec" 31 | external string_array: unit -> string array = "string_array" 32 | external array_conv: bytes -> bytes = "array_conv" 33 | external result_ok: 'a -> ('a, 'b) result = "result_ok" 34 | external result_error: 'a -> ('b, 'a) result = "result_error" 35 | external result_get_ok: ('a, 'b) result -> 'a option = "result_get_ok" 36 | external result_get_error: ('a, 'b) result -> 'b option = "result_get_error" 37 | external all_float_struct_inc_both: all_float_struct -> all_float_struct = "all_float_struct_inc_both" 38 | external float_array_t_inner: float_array_t -> floatarray = "float_array_t_inner" 39 | external make_int32_array_012: unit -> int32 array = "make_int32_array_012" 40 | external make_float_array_f32_012: unit -> float array = "make_float_array_f32_012" 41 | external make_floatarray_f32_012: unit -> floatarray = "make_floatarray_f32_012" 42 | external make_float_array_f64_012: unit -> float array = "make_float_array_f64_012" 43 | external make_floatarray_f64_012: unit -> floatarray = "make_floatarray_f64_012" 44 | 45 | (* file: custom.rs *) 46 | 47 | type testing 48 | type testing_callback 49 | type file 50 | external testing_alloc: int64 -> testing = "testing_alloc" 51 | external testing_set_c: testing -> string -> unit = "testing_set_c" 52 | external testing_set_a: testing -> float -> unit = "testing_set_a" 53 | external testing_get_values: testing -> (float * int64 * string) = "testing_get_values" 54 | external testing_callback_alloc: (int -> float) -> testing_callback = "testing_callback_alloc" 55 | external testing_callback_call: testing_callback -> int -> float = "testing_callback_call" 56 | external file_open: string -> file = "file_open" 57 | external file_read: file -> string = "file_read" 58 | external file_close: file -> unit = "file_close" 59 | 60 | (* file: runtime.rs *) 61 | 62 | external more_than_five_params: float -> float -> float -> float -> float -> float -> float -> float = "more_than_five_params_bytecode" "more_than_five_params" 63 | external mutable_parameter_with_more_than_five_arguments: bool -> bool -> int64 -> int64 -> int64 option -> int32 option -> unit = "mutable_parameter_with_more_than_five_arguments_bytecode" "mutable_parameter_with_more_than_five_arguments" 64 | external raise_exc: float -> unit = "raise_exc" 65 | external raise_failure: unit -> unit = "raise_failure" 66 | external hash_variant_abc: int -> [`Abc of int] = "hash_variant_abc" 67 | external hash_variant_def: float -> [`Def of float] = "hash_variant_def" 68 | external test_panic: unit -> int = "test_panic" 69 | external test_call_named: float -> float = "test_call_named" 70 | external bench_func: unit -> unit = "bench_func" 71 | external bench_native_func: unit -> unit = "bench_native_func" 72 | external exn_to_string: exn -> string = "exn_to_string" 73 | external gc_minor: unit -> unit = "gc_minor" 74 | external gc_major: unit -> unit = "gc_major" 75 | external gc_full_major: unit -> unit = "gc_full_major" 76 | external gc_compact: unit -> unit = "gc_compact" 77 | 78 | (* file: types.rs *) 79 | 80 | external list_length: 'a list -> int = "list_length" 81 | external list_nil: unit -> 'a list = "list_nil" 82 | external list_cons: 'a list -> 'a -> 'a list = "list_cons" 83 | external array_make_range: int -> int -> int array = "array_make_range" 84 | external array_make_range_f: int -> int -> float array = "array_make_range_f" 85 | external array_replace: 'a array -> int -> 'a -> 'a option = "array_replace" 86 | external array1_of_string: string -> (int, int8_unsigned_elt, c_layout) Array1.t = "array1_of_string" 87 | external array1_new: int -> init:int -> (int, int8_unsigned_elt, c_layout) Array1.t = "array1_new" 88 | external array1_from_rust_vec: unit -> (float, float32_elt, c_layout) Array1.t = "array1_from_rust_vec" 89 | external seq_sum: int Seq.t -> int = "seq_sum" 90 | -------------------------------------------------------------------------------- /test/src/rust.mli: -------------------------------------------------------------------------------- 1 | (* Generated by ocaml-rs *) 2 | 3 | open! Bigarray 4 | 5 | (* file: callbacks.rs *) 6 | 7 | external apply1: ('a -> 'b) -> 'a -> 'b = "apply1" 8 | external apply3: ('a -> 'b) -> 'a -> 'b = "apply3" 9 | external apply_range: (int list -> 'a) -> int -> int -> 'a = "apply_range" 10 | 11 | (* file: conv.rs *) 12 | 13 | type enum1 = Empty | First of int | Second of string array 14 | type struct1 = {a: int; b: float; mutable c: string option; d: string array option;} 15 | type all_float_struct = {float_a: float; float_b: float} 16 | type float_array_t = {fa: floatarray} [@@unboxed] 17 | external enum1_empty: unit -> enum1 = "enum1_empty" 18 | external enum1_first: int -> enum1 = "enum1_first" 19 | external enum1_make_second: string -> enum1 = "enum1_make_second" 20 | external enum1_get_second_value: enum1 -> string array option = "enum1_get_second_value" 21 | external enum1_is_empty: enum1 -> bool = "enum1_is_empty" 22 | external struct1_empty: unit -> struct1 = "struct1_empty" 23 | external struct1_get_c: struct1 -> string option = "struct1_get_c" 24 | external struct1_get_d: struct1 -> string array option = "struct1_get_d" 25 | external struct1_set_c: struct1 -> string -> struct1 = "struct1_set_c" 26 | external make_struct1: int -> float -> string option -> string array option -> struct1 = "make_struct1" 27 | external string_non_copying: string -> string = "string_non_copying" 28 | external direct_slice: int64 array -> int64 = "direct_slice" 29 | external deep_clone: 'a -> 'a = "deep_clone" 30 | external pair_vec: unit -> (string * int) array = "pair_vec" 31 | external string_array: unit -> string array = "string_array" 32 | external array_conv: bytes -> bytes = "array_conv" 33 | external result_ok: 'a -> ('a, 'b) result = "result_ok" 34 | external result_error: 'a -> ('b, 'a) result = "result_error" 35 | external result_get_ok: ('a, 'b) result -> 'a option = "result_get_ok" 36 | external result_get_error: ('a, 'b) result -> 'b option = "result_get_error" 37 | external all_float_struct_inc_both: all_float_struct -> all_float_struct = "all_float_struct_inc_both" 38 | external float_array_t_inner: float_array_t -> floatarray = "float_array_t_inner" 39 | external make_int32_array_012: unit -> int32 array = "make_int32_array_012" 40 | external make_float_array_f32_012: unit -> float array = "make_float_array_f32_012" 41 | external make_floatarray_f32_012: unit -> floatarray = "make_floatarray_f32_012" 42 | external make_float_array_f64_012: unit -> float array = "make_float_array_f64_012" 43 | external make_floatarray_f64_012: unit -> floatarray = "make_floatarray_f64_012" 44 | 45 | (* file: custom.rs *) 46 | 47 | type testing 48 | type testing_callback 49 | type file 50 | external testing_alloc: int64 -> testing = "testing_alloc" 51 | external testing_set_c: testing -> string -> unit = "testing_set_c" 52 | external testing_set_a: testing -> float -> unit = "testing_set_a" 53 | external testing_get_values: testing -> (float * int64 * string) = "testing_get_values" 54 | external testing_callback_alloc: (int -> float) -> testing_callback = "testing_callback_alloc" 55 | external testing_callback_call: testing_callback -> int -> float = "testing_callback_call" 56 | external file_open: string -> file = "file_open" 57 | external file_read: file -> string = "file_read" 58 | external file_close: file -> unit = "file_close" 59 | 60 | (* file: runtime.rs *) 61 | 62 | external more_than_five_params: float -> float -> float -> float -> float -> float -> float -> float = "more_than_five_params_bytecode" "more_than_five_params" 63 | external mutable_parameter_with_more_than_five_arguments: bool -> bool -> int64 -> int64 -> int64 option -> int32 option -> unit = "mutable_parameter_with_more_than_five_arguments_bytecode" "mutable_parameter_with_more_than_five_arguments" 64 | external raise_exc: float -> unit = "raise_exc" 65 | external raise_failure: unit -> unit = "raise_failure" 66 | external hash_variant_abc: int -> [`Abc of int] = "hash_variant_abc" 67 | external hash_variant_def: float -> [`Def of float] = "hash_variant_def" 68 | external test_panic: unit -> int = "test_panic" 69 | external test_call_named: float -> float = "test_call_named" 70 | external bench_func: unit -> unit = "bench_func" 71 | external bench_native_func: unit -> unit = "bench_native_func" 72 | external exn_to_string: exn -> string = "exn_to_string" 73 | external gc_minor: unit -> unit = "gc_minor" 74 | external gc_major: unit -> unit = "gc_major" 75 | external gc_full_major: unit -> unit = "gc_full_major" 76 | external gc_compact: unit -> unit = "gc_compact" 77 | 78 | (* file: types.rs *) 79 | 80 | external list_length: 'a list -> int = "list_length" 81 | external list_nil: unit -> 'a list = "list_nil" 82 | external list_cons: 'a list -> 'a -> 'a list = "list_cons" 83 | external array_make_range: int -> int -> int array = "array_make_range" 84 | external array_make_range_f: int -> int -> float array = "array_make_range_f" 85 | external array_replace: 'a array -> int -> 'a -> 'a option = "array_replace" 86 | external array1_of_string: string -> (int, int8_unsigned_elt, c_layout) Array1.t = "array1_of_string" 87 | external array1_new: int -> init:int -> (int, int8_unsigned_elt, c_layout) Array1.t = "array1_new" 88 | external array1_from_rust_vec: unit -> (float, float32_elt, c_layout) Array1.t = "array1_from_rust_vec" 89 | external seq_sum: int Seq.t -> int = "seq_sum" 90 | -------------------------------------------------------------------------------- /test/src/types.ml: -------------------------------------------------------------------------------- 1 | open Rust 2 | open Bigarray 3 | 4 | let%test "list length (empty)" = Util.check_leaks (fun () -> list_length [] = 0) 5 | let%test "list length (small)"= Util.check_leaks (fun () -> list_length [1; 2; 3] = 3) 6 | let%test "list length (big)" = Util.check_leaks (fun ()-> list_length (Array.make 10000 0 |> Array.to_list) = 10000) 7 | 8 | let%test "list nil" = Util.check_leaks (fun () -> list_nil () = []) 9 | let%test "list cons 1" = Util.check_leaks (fun () -> list_cons (list_nil ()) 12.5 = [12.5]) 10 | let%test "list cons 2" = Util.check_leaks (fun () -> let a = list_cons (list_cons (list_nil ()) 12.5) 11.5 in Util.gc (); a = [11.5; 12.5]) 11 | 12 | let%test "array make range 1" = Util.check_leaks (fun () -> array_make_range 0 0 = [||]) 13 | let%test "array make range 2" = Util.check_leaks (fun () -> let a = array_make_range 0 10 in Util.gc (); a = [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9|]) 14 | let%test "array make range f" = Util.check_leaks (fun () -> let a = array_make_range_f 0 50_000 in Util.gc (); Array.length a = 50_000) 15 | let%test "array replace 1" = Util.check_leaks (fun () -> 16 | let a = [| "A"; "B"; "C" |] in 17 | (array_replace a 1 "X" = (Some "B")) && (a.(1) = "X") 18 | ) 19 | 20 | let%test "array1 of empty string" = Util.check_leaks (fun () -> Array1.dim (array1_of_string "") = 0) 21 | let%test "array1 of string 1" = Util.check_leaks (fun () -> 22 | let a = array1_of_string "test" in 23 | Util.gc (); 24 | Array1.dim a = 4 && 25 | a.{0} = (int_of_char 't') && 26 | a.{1} = (int_of_char 'e') && 27 | a.{2} = (int_of_char 's') && 28 | a.{3} = (int_of_char 't') 29 | ) 30 | let%test "array1 new" = Util.check_leaks (fun () -> 31 | let arr = array1_new 10 ~init:5 in 32 | Util.gc (); 33 | let status = ref true in 34 | for i = 0 to 9 do 35 | status := !status && Array1.unsafe_get arr i = 5 36 | done; 37 | !status 38 | ) 39 | let%test "array1 from rust vec" = Util.check_leaks (fun () -> 40 | let a = array1_from_rust_vec () in 41 | Util.gc (); 42 | a.{0} = 1. && 43 | a.{1} = 2. && 44 | a.{2} = 3. && 45 | a.{3} = 4. && 46 | a.{4} = 5. 47 | ) 48 | 49 | type array2_t = (float, float32_elt, c_layout) Array2.t 50 | 51 | external make_array2: int -> int -> array2_t = "make_array2" 52 | external array2_format: array2_t -> string = "array2_format" 53 | external array2_set: array2_t -> int -> int -> float -> unit = "array2_set" 54 | external array2_get: array2_t -> int -> int -> float = "array2_get" 55 | 56 | let test_array2_checked dim1 dim2 = ( 57 | let arr = make_array2 dim1 dim2 in 58 | let rec check x y v = 59 | if not v || x == dim1 then v else 60 | if y == dim2 then 61 | check (x + 1) 0 v 62 | else 63 | let value = float_of_int (x * y) in 64 | array2_set arr x y value; 65 | check x (y + 1) (array2_get arr x y = value && arr.{x, y} = value) 66 | in 67 | arr, check 0 0 true 68 | ) 69 | 70 | let%test "array2" = Util.check_leaks (fun () -> 71 | let dim1 = 9000 and dim2 = 800 in 72 | let _, check = test_array2_checked dim1 dim2 in 73 | check 74 | ) 75 | 76 | let%test "array2_format" = Util.check_leaks (fun () -> 77 | let dim1 = 3 and dim2 = 3 in 78 | let arr, check = test_array2_checked dim1 dim2 in 79 | let () = Util.gc () in 80 | check && (array2_format arr) = "[[0, 0, 0], [0, 1, 2], [0, 2, 4]]" 81 | ) 82 | 83 | type abstract_ptr 84 | 85 | external alloc_abstract_pointer : float -> abstract_ptr = "alloc_abstract_pointer" 86 | external abstract_pointer_value : abstract_ptr -> float = "abstract_pointer_value" 87 | external abstract_pointer_free: abstract_ptr -> unit = "abstract_pointer_free" 88 | 89 | let%test "abstract pointer" = Util.check_leaks (fun () -> 90 | let a = alloc_abstract_pointer 1.5 in 91 | Util.gc (); 92 | let f = abstract_pointer_value a in 93 | Util.gc (); 94 | abstract_pointer_free a; f = 1.5 95 | ) 96 | 97 | let%test "seq sum" = Util.check_leaks (fun () -> 98 | let l = List.init 100 (fun x -> x) in 99 | let s = List.to_seq l in 100 | let sum = seq_sum s in 101 | let sum' = List.fold_left ( + ) 0 l in 102 | sum = sum' 103 | ) 104 | -------------------------------------------------------------------------------- /test/src/types.rs: -------------------------------------------------------------------------------- 1 | use ocaml::Value; 2 | 3 | #[ocaml::func] 4 | #[ocaml::sig("'a list -> int")] 5 | pub unsafe fn list_length(x: ocaml::List) -> ocaml::Int { 6 | x.len() as ocaml::Int 7 | } 8 | 9 | #[ocaml::func] 10 | #[ocaml::sig("unit -> 'a list")] 11 | pub fn list_nil() -> ocaml::List { 12 | ocaml::List::empty() 13 | } 14 | 15 | #[ocaml::func] 16 | #[ocaml::sig("'a list -> 'a -> 'a list")] 17 | pub unsafe fn list_cons( 18 | l: ocaml::List, 19 | x: ocaml::Value, 20 | ) -> ocaml::List { 21 | l.add(gc, &x) 22 | } 23 | 24 | #[ocaml::func] 25 | #[ocaml::sig("int -> int -> int array")] 26 | pub unsafe fn array_make_range( 27 | start: ocaml::Uint, 28 | stop: ocaml::Uint, 29 | ) -> Result, ocaml::Error> { 30 | let len = stop - start; 31 | let mut arr = ocaml::Array::alloc(len); 32 | 33 | for i in 0..len { 34 | arr.set(gc, i, &Value::uint(i + start))?; 35 | } 36 | Ok(arr) 37 | } 38 | 39 | #[ocaml::func] 40 | #[ocaml::sig("int -> int -> float array")] 41 | pub fn array_make_range_f(start: isize, stop: isize) -> Vec { 42 | (start..stop).map(|x| x as f64).collect() 43 | } 44 | 45 | #[ocaml::func] 46 | #[ocaml::sig("'a array -> int -> 'a -> 'a option")] 47 | pub unsafe fn array_replace( 48 | mut arr: ocaml::Array, 49 | index: ocaml::Uint, 50 | x: Value, 51 | ) -> Result, ocaml::Error> { 52 | let y = arr.get(gc, index)?; 53 | arr.set(gc, index, &x)?; 54 | Ok(Some(y)) 55 | } 56 | 57 | #[ocaml::func] 58 | #[ocaml::sig("string -> (int, int8_unsigned_elt, c_layout) Array1.t")] 59 | pub unsafe fn array1_of_string(x: String) -> ocaml::bigarray::Array1 { 60 | ocaml::bigarray::Array1::from_slice(x.as_bytes()) 61 | } 62 | 63 | #[ocaml::func] 64 | #[ocaml::sig("int -> init:int -> (int, int8_unsigned_elt, c_layout) Array1.t")] 65 | pub unsafe fn array1_new(len: ocaml::Uint, init: u8) -> ocaml::bigarray::Array1 { 66 | let mut ba = ocaml::bigarray::Array1::::create(len); 67 | let data = ba.data_mut(); 68 | for i in data { 69 | *i = init; 70 | } 71 | ba 72 | } 73 | 74 | #[ocaml::func] 75 | #[ocaml::sig("unit -> (float, float32_elt, c_layout) Array1.t")] 76 | pub unsafe fn array1_from_rust_vec() -> ocaml::bigarray::Array1 { 77 | ocaml::bigarray::Array1::from_slice([1f32, 2f32, 3f32, 4f32, 5f32]) 78 | } 79 | 80 | #[ocaml::func] 81 | pub unsafe fn make_array2(dim1: usize, dim2: usize) -> ocaml::bigarray::Array2 { 82 | let arr = ndarray::Array2::zeros((dim1, dim2)); 83 | ocaml::bigarray::Array2::from_ndarray(arr) 84 | } 85 | 86 | #[ocaml::func] 87 | pub fn array2_set(mut arr: ocaml::bigarray::Array2, x: usize, y: usize, v: f32) { 88 | let mut view = arr.view_mut(); 89 | view[[x, y]] = v; 90 | } 91 | 92 | #[ocaml::func] 93 | pub fn array2_get(arr: ocaml::bigarray::Array2, x: usize, y: usize) -> f64 { 94 | let view = arr.view(); 95 | view[[x, y]] as f64 96 | } 97 | 98 | #[ocaml::func] 99 | pub fn array2_format(arr: ocaml::bigarray::Array2) -> String { 100 | format!("{}", arr.view()).replace('\n', "") 101 | } 102 | 103 | #[derive(Debug)] 104 | struct Abstract { 105 | f: f64, 106 | } 107 | 108 | #[ocaml::func] 109 | pub unsafe fn alloc_abstract_pointer(f: ocaml::Float) -> Value { 110 | let a = Box::into_raw(Box::new(Abstract { f })); 111 | Value::alloc_abstract_ptr(a) 112 | } 113 | 114 | #[ocaml::func] 115 | pub unsafe fn abstract_pointer_value(f: Value) -> f64 { 116 | let f = f.abstract_ptr_val::(); 117 | (*f).f 118 | } 119 | 120 | #[ocaml::func] 121 | pub unsafe fn abstract_pointer_free(f: Value) { 122 | let f = f.abstract_ptr_val_mut::(); 123 | drop(Box::from_raw(f)); 124 | } 125 | 126 | #[ocaml::func] 127 | #[ocaml::sig("int Seq.t -> int")] 128 | pub unsafe fn seq_sum(seq: ocaml::Seq) -> Result { 129 | let mut sum = 0; 130 | for i in seq { 131 | let i = i?; 132 | sum += i; 133 | } 134 | Ok(sum) 135 | } 136 | -------------------------------------------------------------------------------- /test/src/util.ml: -------------------------------------------------------------------------------- 1 | let gc () = 2 | Gc.compact (); 3 | Gc.minor (); 4 | Gc.full_major () 5 | 6 | let check_leaks f = 7 | let () = gc () in 8 | let stat = (Gc.stat ()).live_blocks in 9 | let r = f () in 10 | let () = gc () in 11 | let stat1 = (Gc.stat ()).live_blocks in 12 | if stat1 > stat then 13 | Printf.printf "Potential GC leak detected: %d, %d\n" stat stat1; 14 | assert (stat >= stat1); 15 | r 16 | --------------------------------------------------------------------------------