[WIP] Ocaml support

Cargo.toml

@@ -5,8 +5,9 @@ members = [
     "source/carton-utils",
     "source/carton-runner-packager",
     "source/carton-runner-interface",
-    "source/carton-bindings-py",
     "source/carton-bindings-nodejs",
+    "source/carton-bindings-ocaml",
+    "source/carton-bindings-py",
     "source/carton-bindings-wasm",
     "source/carton-macros",
     "source/carton-runner-noop",

source/carton-bindings-ocaml/Cargo.toml

@@ -0,0 +1,15 @@
+[package]
+name = "carton-bindings-ocaml"
+version = "0.1.0"
+edition = "2021"
+publish = false
+
+[lib]
+crate-type = ["staticlib", "cdylib"]
+
+[dependencies]
+carton-core = { package = "carton", path = "../carton" }
+tokio = { version = "1", features = ["full"] }
+ocaml-rust = { git = "https://github.com/LaurentMazare/ocaml-rust", rev = "7487c126bfa0785bd32e72918bc37a16d4d7d203" }
+ocaml-sys = "0.23.0"
+ndarray = "0.15.6"

source/carton-bindings-ocaml/build.sh

@@ -0,0 +1,15 @@
+#!/bin/env bash
+
+output=$(cargo build $1 --message-format json | tail -n 2 | head -n 1)
+file_names=$(echo "$output" | jq -r ".filenames|.[]")
+
+for name in $file_names; do
+    if [[ "$(printf "%s" "$name" | tail -c 2)" == ".a" ]]; then
+        cp "$name" "cartonml/lib/libcarton_bindings_ocaml.a"
+    else
+        cp "$name" "cartonml/lib/dllcarton_bindings_ocaml.so"
+    fi
+done
+
+cd cartonml
+dune build

source/carton-bindings-ocaml/cartonml/.gitignore

@@ -0,0 +1,33 @@
+*.annot
+*.cmo
+*.cma
+*.cmi
+*.a
+*.o
+*.cmx
+*.cmxs
+*.cmxa
+
+# ocamlbuild working directory
+_build/
+
+# ocamlbuild targets
+*.byte
+*.native
+
+# oasis generated files
+setup.data
+setup.log
+
+# Merlin configuring file for Vim and Emacs
+.merlin
+
+# Dune generated files
+*.install
+
+# Local OPAM switch
+_opam/
+
+# Dlls
+lib/*.so
+lib/*.a

source/carton-bindings-ocaml/cartonml/.ocamlformat

@@ -0,0 +1,4 @@
+profile = janestreet
+break-cases = fit
+margin = 77
+wrap-comments = true

source/carton-bindings-ocaml/cartonml/cartonml.opam

@@ -0,0 +1,36 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "run any ML model from any programming language"
+description: """
+
+Carton is a library that lets you run any machine learning (ML) model from any programming language*.
+It wraps existing models and provides a uniform interface for your application to use regardless of the framework the underlying model was implemented in.
+See https://carton.run for an overview of how it works and how to get started.
+"""
+maintainer: ["Arthur Melton"]
+authors: ["Vivek Panyam"]
+license: "Apache-2.0"
+tags: ["ML"]
+homepage: "https://github.com/VivekPanyam/carton"
+doc: "https://carton.run/quickstart"
+bug-reports: "https://github.com/VivekPanyam/carton/issues"
+depends: [
+  "ocaml"
+  "dune" {>= "3.10"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/VivekPanyam/carton.git"

source/carton-bindings-ocaml/cartonml/dune-project

@@ -0,0 +1,29 @@
+(lang dune 3.10)
+
+(name cartonml)
+
+(generate_opam_files true)
+
+(source
+ (github VivekPanyam/carton))
+
+(authors "Vivek Panyam")
+
+(maintainers "Arthur Melton")
+
+(license Apache-2.0)
+
+(documentation https://carton.run/quickstart)
+
+(package
+ (name cartonml)
+ (synopsis "run any ML model from any programming language")
+ (description "
+Carton is a library that lets you run any machine learning (ML) model from any programming language*.
+It wraps existing models and provides a uniform interface for your application to use regardless of the framework the underlying model was implemented in.
+See https://carton.run for an overview of how it works and how to get started.
+")
+ (depends ocaml dune)
+ (tags ("ML")))
+
+; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project

source/carton-bindings-ocaml/cartonml/lib/cartonml.ml

@@ -0,0 +1,45 @@
+open Option
+
+type f_f_i_carton
+type f_f_i_carton_error
+
+type tensor =
+  | Float of float array
+  | Double of float array
+  | I8 of Int64.t array
+  | I16 of Int64.t array
+  | I32 of Int64.t array
+  | I64 of Int64.t array
+  | U8 of Int64.t array
+  | U16 of Int64.t array
+  | U32 of Int64.t array
+  | U64 of Int64.t array
+  | String of string array
+[@@boxed]
+
+external _load
+  :  string
+  -> string option
+  -> string option
+  -> string option
+  -> (f_f_i_carton, f_f_i_carton_error) Result.t
+  = "__ocaml_ffi_load"
+
+external infer
+  :  f_f_i_carton
+  -> (string * tensor) array
+  -> (string * tensor) array
+  = "__ocaml_ffi_infer"
+
+let load
+  ?(visible_device = none)
+  ?(override_runner_name = none)
+  ?(override_required_framework_version = none)
+  path
+  =
+  _load
+    path
+    visible_device
+    override_runner_name
+    override_required_framework_version
+;;

source/carton-bindings-ocaml/cartonml/lib/cartonml.mli

@@ -0,0 +1,28 @@
+type f_f_i_carton
+type f_f_i_carton_error
+
+type tensor =
+  | Float of float array
+  | Double of float array
+  | I8 of Int64.t array
+  | I16 of Int64.t array
+  | I32 of Int64.t array
+  | I64 of Int64.t array
+  | U8 of Int64.t array
+  | U16 of Int64.t array
+  | U32 of Int64.t array
+  | U64 of Int64.t array
+  | String of string array
+
+external infer
+  :  f_f_i_carton
+  -> (string * tensor) array
+  -> (string * tensor) array
+  = "__ocaml_ffi_infer"
+
+val load
+  :  ?visible_device:string option
+  -> ?override_runner_name:string option
+  -> ?override_required_framework_version:string option
+  -> string
+  -> (f_f_i_carton, f_f_i_carton_error) Result.t

source/carton-bindings-ocaml/cartonml/lib/dune

@@ -0,0 +1,5 @@
+(library
+ (public_name cartonml)
+ (foreign_archives carton_bindings_ocaml)
+ (c_library_flags
+  (-llzma -lbz2)))

source/carton-bindings-ocaml/src/export.rs

@@ -0,0 +1,33 @@
+use crate::*;
+
+#[ocaml_rust::bridge]
+mod ffi {
+    type FFICarton = Custom<Carton>;
+    type FFICartonError = Custom<CartonError>;
+
+    #[derive(Clone, Debug)]
+    pub enum Tensor {
+        Float(Vec<f32>),
+        Double(Vec<f64>),
+        I8(Vec<i64>),
+        I16(Vec<i64>),
+        I32(Vec<i64>),
+        I64(Vec<i64>),
+        U8(Vec<i64>),
+        U16(Vec<i64>),
+        U32(Vec<i64>),
+        U64(Vec<i64>),
+        String(Vec<String>),
+    }
+
+    extern "Rust" {
+        fn load(
+            path: String,
+            visible_device: Option<String>,
+            override_runner_name: Option<String>,
+            override_required_framework_version: Option<String>,
+        ) -> Result<FFICarton, FFICartonError>;
+
+        fn infer(model: FFICarton, tensors: Vec<(String, Tensor)>) -> Vec<(String, Tensor)>;
+    }
+}

source/carton-bindings-ocaml/src/lib.rs

@@ -0,0 +1,57 @@
+mod export;
+mod tensor;
+mod utils;
+
+use crate::export::Tensor;
+use crate::utils::runtime;
+
+use carton_core::error::CartonError;
+use carton_core::types::{Device, LoadOpts, Tensor as CartonTensor};
+use carton_core::Carton;
+use ocaml_rust::Custom;
+
+/// Load a carton model
+fn load(
+    path: String,
+    visible_device: Option<String>,
+    override_runner_name: Option<String>,
+    override_required_framework_version: Option<String>,
+) -> Result<Custom<Carton>, Custom<CartonError>> {
+    runtime().block_on(async {
+        let opts = LoadOpts {
+            override_runner_name,
+            override_required_framework_version,
+            override_runner_opts: None,
+            visible_device: match visible_device {
+                None => carton_core::types::Device::default(),
+                Some(visible_device) => Device::maybe_from_str(&visible_device).unwrap(),
+            },
+        };
+
+        match Carton::load(path, opts).await {
+            Ok(x) => Ok(Custom::new(x)),
+            Err(x) => Err(Custom::new(x)),
+        }
+    })
+}
+
+/// Infer the data
+fn infer(model: Custom<Carton>, tensors: Vec<(String, Tensor)>) -> Vec<(String, Tensor)> {
+    runtime().block_on(async {
+        let transformed: Vec<(_, CartonTensor<_>)> = tensors
+            .into_iter()
+            .map(|(k, v)| (k, CartonTensor::from(v)))
+            .collect();
+
+        model
+            .inner()
+            .lock()
+            .unwrap()
+            .infer(transformed)
+            .await
+            .unwrap()
+            .into_iter()
+            .map(|(x, y)| (x, y.into()))
+            .collect()
+    })
+}

source/carton-bindings-ocaml/src/tensor.rs

@@ -0,0 +1,65 @@
+use carton_core::types::{GenericStorage, Tensor, TensorStorage, TypedStorage};
+
+use crate::Tensor as SupportedTensorType;
+
+macro_rules! from_tensor_int {
+    ( $over:ident, $x:expr ) => {
+        SupportedTensorType::$over(
+            $x.view()
+                .into_owned()
+                .into_raw_vec()
+                .into_iter()
+                .map(|x| x as i64)
+                .collect(),
+        )
+    };
+}
+
+macro_rules! to_tensor_int {
+    ( $over:ident, $x:expr, $as:ident ) => {
+        Tensor::<GenericStorage>::$over(
+            ndarray::ArrayD::from_shape_vec(
+                ndarray::IxDyn(&[1]),
+                $x.into_iter().map(|x| x as $as).collect(),
+            )
+            .unwrap(),
+        )
+    };
+}
+
+impl<T: TensorStorage> From<Tensor<T>> for SupportedTensorType {
+    fn from(item: Tensor<T>) -> Self {
+        match item {
+            Tensor::Float(x) => SupportedTensorType::Float(x.view().into_owned().into_raw_vec()),
+            Tensor::Double(x) => SupportedTensorType::Double(x.view().into_owned().into_raw_vec()),
+            Tensor::I8(x) => from_tensor_int!(I8, x),
+            Tensor::I16(x) => from_tensor_int!(I16, x),
+            Tensor::I32(x) => from_tensor_int!(I32, x),
+            Tensor::I64(x) => from_tensor_int!(I64, x),
+            Tensor::U8(x) => from_tensor_int!(U8, x),
+            Tensor::U16(x) => from_tensor_int!(U16, x),
+            Tensor::U32(x) => from_tensor_int!(U32, x),
+            Tensor::U64(x) => from_tensor_int!(U64, x),
+            Tensor::String(x) => SupportedTensorType::String(x.view().into_owned().into_raw_vec()),
+            Tensor::NestedTensor(_) => panic!("Nested tensor output not implemented yet"),
+        }
+    }
+}
+
+impl From<SupportedTensorType> for Tensor<GenericStorage> {
+    fn from(item: SupportedTensorType) -> Self {
+        match item {
+            SupportedTensorType::Float(x) => to_tensor_int!(Float, x, f32),
+            SupportedTensorType::Double(x) => to_tensor_int!(Double, x, f64),
+            SupportedTensorType::String(x) => to_tensor_int!(String, x, String),
+            SupportedTensorType::I8(x) => to_tensor_int!(I8, x, i8),
+            SupportedTensorType::I16(x) => to_tensor_int!(I16, x, i16),
+            SupportedTensorType::I32(x) => to_tensor_int!(I32, x, i32),
+            SupportedTensorType::I64(x) => to_tensor_int!(I64, x, i64),
+            SupportedTensorType::U8(x) => to_tensor_int!(U8, x, u8),
+            SupportedTensorType::U16(x) => to_tensor_int!(U16, x, u16),
+            SupportedTensorType::U32(x) => to_tensor_int!(U32, x, u32),
+            SupportedTensorType::U64(x) => to_tensor_int!(U64, x, u64),
+        }
+    }
+}

source/carton-bindings-ocaml/src/utils.rs

@@ -0,0 +1,11 @@
+// Stolen from carton-bindings-c/src/utils.rs
+
+use std::sync::OnceLock;
+
+use tokio::runtime::Runtime;
+
+/// A utility to lazily start a tokio runtime
+pub(crate) fn runtime() -> &'static Runtime {
+    static CELL: OnceLock<Runtime> = OnceLock::new();
+    CELL.get_or_init(|| Runtime::new().unwrap())
+}