// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.
#![feature(exit_status_error)]

use std::cell::RefCell;
use std::collections::BTreeMap;
use std::collections::BTreeSet;

use ocamlrep::FromOcamlRep;
use ocamlrep::ToOcamlRep;

fn val<T: FromOcamlRep + ToOcamlRep>(value: T) -> usize {
    let arena = Box::leak(Box::new(ocamlrep::Arena::new()));
    let value = arena.add(&value);
    // Round-trip back to T to exercise from_ocamlrep.
    let value = T::from_ocamlrep(value).unwrap();
    let value = arena.add(&value);
    value.to_bits()
}

#[no_mangle]
pub unsafe extern "C" fn convert_to_ocamlrep(value: usize) -> usize {
    let arena = Box::leak(Box::new(ocamlrep::Arena::new()));
    let value = ocamlrep::Value::from_bits(value);
    let value = value.clone_with_allocator(arena);
    value.to_bits()
}

#[no_mangle]
pub extern "C" fn realloc_in_ocaml_heap(value: usize) -> usize {
    let value = unsafe { ocamlrep::Value::from_bits(value) };
    let pool = unsafe { ocamlrep_ocamlpool::Pool::new() };
    value.clone_with_allocator(&pool).to_bits()
}

// Primitive Tests

#[no_mangle]
pub extern "C" fn get_a(_unit: usize) -> usize {
    val('a')
}

#[no_mangle]
pub extern "C" fn get_five(_unit: usize) -> usize {
    val(5)
}

#[no_mangle]
pub extern "C" fn get_true(_unit: usize) -> usize {
    val(true)
}

#[no_mangle]
pub extern "C" fn get_false(_unit: usize) -> usize {
    val(false)
}

// Option Tests

#[no_mangle]
pub extern "C" fn get_none(_unit: usize) -> usize {
    val(None::<isize>)
}

#[no_mangle]
pub extern "C" fn get_some_five(_unit: usize) -> usize {
    val(Some(5))
}

#[no_mangle]
pub extern "C" fn get_some_none(_unit: usize) -> usize {
    val(Some(None::<isize>))
}

#[no_mangle]
pub extern "C" fn get_some_some_five(_unit: usize) -> usize {
    val(Some(Some(5)))
}

// Ref tests

#[no_mangle]
pub extern "C" fn get_int_ref(_unit: usize) -> usize {
    val(RefCell::new(5))
}

#[no_mangle]
pub extern "C" fn get_int_option_ref(_unit: usize) -> usize {
    val(RefCell::new(Some(5)))
}

// Unsized type tests

#[no_mangle]
pub extern "C" fn get_str(_unit: usize) -> usize {
    let arena = Box::leak(Box::new(ocamlrep::Arena::new()));
    arena.add("static str").to_bits()
}

#[no_mangle]
pub extern "C" fn get_byte_slice(_unit: usize) -> usize {
    let arena = Box::leak(Box::new(ocamlrep::Arena::new()));
    arena.add(&b"byte\x00\xFFslice"[..]).to_bits()
}

#[no_mangle]
pub extern "C" fn get_int_opt_slice(_unit: usize) -> usize {
    let arena = Box::leak(Box::new(ocamlrep::Arena::new()));
    let vec = vec![None, Some(2), Some(3)];
    let slice = &vec[..];
    arena.add(slice).to_bits()
}

// List Tests

#[no_mangle]
pub extern "C" fn get_empty_list(_unit: usize) -> usize {
    val(Vec::<isize>::new())
}

#[no_mangle]
pub extern "C" fn get_five_list(_unit: usize) -> usize {
    val(vec![5])
}

#[no_mangle]
pub extern "C" fn get_one_two_three_list(_unit: usize) -> usize {
    val(vec![1, 2, 3])
}

#[no_mangle]
pub extern "C" fn get_float_list(_unit: usize) -> usize {
    val(vec![1.0, 2.0, 3.0])
}

// Struct tests

#[derive(FromOcamlRep, ToOcamlRep)]
struct Foo {
    a: isize,
    b: bool,
}

#[derive(FromOcamlRep, ToOcamlRep)]
struct Bar {
    c: Foo,
    d: Option<Vec<Option<isize>>>,
}

#[no_mangle]
pub extern "C" fn get_foo(_unit: usize) -> usize {
    val(Foo { a: 25, b: true })
}

#[no_mangle]
pub extern "C" fn get_bar(_unit: usize) -> usize {
    val(Bar {
        c: Foo { a: 42, b: false },
        d: Some(vec![Some(88), None, Some(66)]),
    })
}

// String Tests

#[no_mangle]
pub extern "C" fn get_empty_string(_unit: usize) -> usize {
    val(String::from(""))
}

#[no_mangle]
pub extern "C" fn get_a_string(_unit: usize) -> usize {
    val(String::from("a"))
}

#[no_mangle]
pub extern "C" fn get_ab_string(_unit: usize) -> usize {
    val(String::from("ab"))
}

#[no_mangle]
pub extern "C" fn get_abcde_string(_unit: usize) -> usize {
    val(String::from("abcde"))
}

#[no_mangle]
pub extern "C" fn get_abcdefg_string(_unit: usize) -> usize {
    val(String::from("abcdefg"))
}

#[no_mangle]
pub extern "C" fn get_abcdefgh_string(_unit: usize) -> usize {
    val(String::from("abcdefgh"))
}

#[no_mangle]
pub extern "C" fn get_zero_float(_unit: usize) -> usize {
    val(0.0_f64)
}

#[no_mangle]
pub extern "C" fn get_one_two_float(_unit: usize) -> usize {
    val(1.2_f64)
}

// Variant tests

#[derive(FromOcamlRep, ToOcamlRep)]
enum Fruit {
    Apple,
    Orange(isize),
    Pear { num: isize },
    Kiwi,
}

#[no_mangle]
pub extern "C" fn get_apple(_unit: usize) -> usize {
    val(Fruit::Apple)
}

#[no_mangle]
pub extern "C" fn get_orange(_unit: usize) -> usize {
    val(Fruit::Orange(39))
}

#[no_mangle]
pub extern "C" fn get_pear(_unit: usize) -> usize {
    val(Fruit::Pear { num: 76 })
}

#[no_mangle]
pub extern "C" fn get_kiwi(_unit: usize) -> usize {
    val(Fruit::Kiwi)
}

// Map tests

#[no_mangle]
pub extern "C" fn get_empty_smap(_unit: usize) -> usize {
    let map: BTreeMap<String, isize> = BTreeMap::new();
    val(map)
}

#[no_mangle]
pub extern "C" fn get_int_smap_singleton(_unit: usize) -> usize {
    let mut map = BTreeMap::new();
    map.insert(String::from("a"), 1);
    val(map)
}

#[no_mangle]
pub extern "C" fn get_int_smap(_unit: usize) -> usize {
    let mut map = BTreeMap::new();
    map.insert(String::from("a"), 1);
    map.insert(String::from("b"), 2);
    map.insert(String::from("c"), 3);
    val(map)
}

// Set tests

#[no_mangle]
pub extern "C" fn get_empty_sset(_unit: usize) -> usize {
    let set: BTreeSet<String> = BTreeSet::new();
    val(set)
}

#[no_mangle]
pub extern "C" fn get_sset_singleton(_unit: usize) -> usize {
    let mut set = BTreeSet::new();
    set.insert(String::from("a"));
    val(set)
}

#[no_mangle]
pub extern "C" fn get_sset(_unit: usize) -> usize {
    let mut set = BTreeSet::new();
    set.insert(String::from("a"));
    set.insert(String::from("b"));
    set.insert(String::from("c"));
    val(set)
}

#[no_mangle]
pub extern "C" fn roundtrip_int64(value: usize) -> usize {
    let i = unsafe { ocamlrep_caml_builtins::Int64::from_ocaml(value).unwrap() };
    val(i)
}

// Hack! Trick buck into believing that these libraries are used. See [Note:
// Test blocks for Cargo] in `ocamlrep_ocamlpool/test/ocamlpool_test.rs`.
const _: () = {
    #[allow(unused_imports)]
    use anyhow;
    #[allow(unused_imports)]
    use cargo_test_utils;
    #[allow(unused_imports)]
    use tempdir;
};

#[cfg(test)]
mod tests {
    use anyhow::Result;
    use cargo_test_utils::*;
    use tempdir::TempDir;

    #[test]
    fn ocamlrep_test() -> Result<()> {
        let parent = std::path::Path::new("..");
        let tmp_dir = TempDir::new("ocamlrep_test")?;
        std::fs::copy(
            parent.join("test_ocamlrep.ml"),
            tmp_dir.path().join("test_ocamlrep.ml"),
        )?;
        let compile_cmd = cmd(
            "ocamlopt.opt",
            &[
                "-verbose",
                "-c",
                "test_ocamlrep.ml",
                "-o",
                "test_ocamlrep_ml.cmx",
            ],
            Some(&tmp_dir.path()),
        );
        assert_eq!(run(compile_cmd).map_err(fmt_exit_status_err), Ok(()));
        let link_cmd = cmd(
            "ocamlopt.opt",
            &[
                "-verbose",
                "-o",
                "ocamlrep_test",
                "test_ocamlrep_ml.cmx",
                "-ccopt",
                &("-L".to_owned() + workspace_dir(&["target", build_flavor()]).to_str().unwrap()),
                "-cclib",
                "-ltest_bindings",
                "-cclib",
                "-locamlrep_ocamlpool",
            ],
            Some(&tmp_dir.path()),
        );
        assert_eq!(run(link_cmd).map_err(fmt_exit_status_err), Ok(()));
        let ocamlrep_test_cmd = cmd(
            tmp_dir
                .path()
                .join("ocamlrep_test")
                .as_path()
                .to_str()
                .unwrap(),
            &[],
            None,
        );
        assert_eq!(run(ocamlrep_test_cmd).map_err(fmt_exit_status_err), Ok(()));
        tmp_dir.close()?;
        Ok(())
    }
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

#![cfg(test)]

use ocamlrep::Allocator;
use ocamlrep::Arena;
use ocamlrep::FromError::*;
use ocamlrep::FromOcamlRep;
use ocamlrep::ToOcamlRep;
use ocamlrep::Value;

#[test]
fn expected_block_but_got_int() {
    let value = Value::int(42);
    let err = <(isize, isize)>::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, ExpectedBlock(42));
}

#[test]
fn expected_int_but_got_block() {
    let arena = Arena::new();
    let value = arena.block_with_size_and_tag(1, 0).build();
    let err = isize::from_ocamlrep(value).err().unwrap();
    match err {
        ExpectedInt(..) => {}
        _ => panic!("unexpected error: {}", err),
    }
}

#[test]
fn wrong_tag_for_none() {
    let value = Value::int(1);
    let err = <Option<isize>>::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, NullaryVariantTagOutOfRange { max: 0, actual: 1 });
}

#[test]
fn wrong_tag_for_some() {
    let arena = Arena::new();
    let value = arena.block_with_size_and_tag(1, 1).build();
    let err = <Option<isize>>::from_ocamlrep(value).err().unwrap();
    assert_eq!(
        err,
        ExpectedBlockTag {
            expected: 0,
            actual: 1
        }
    );
}

#[test]
fn out_of_bool_range() {
    let value = Value::int(42);
    let err = bool::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, ExpectedBool(42));
}

#[test]
fn out_of_char_range() {
    let value = Value::int(-1);
    let err = char::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, ExpectedChar(-1));
}

#[derive(FromOcamlRep, ToOcamlRep)]
struct Foo {
    a: isize,
    b: bool,
}

#[test]
fn bad_struct_field() {
    let arena = Arena::new();
    let value = {
        let mut foo = arena.block_with_size_and_tag(2, 0);
        arena.set_field(&mut foo, 0, Value::int(0));
        arena.set_field(&mut foo, 1, Value::int(42));
        foo.build()
    };
    let err = Foo::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, ErrorInField(1, Box::new(ExpectedBool(42))));
}

#[derive(FromOcamlRep, ToOcamlRep)]
struct Bar {
    c: Foo,
    d: Option<Vec<Option<isize>>>,
}

#[test]
fn bad_nested_struct_field() {
    let arena = Arena::new();

    let foo = {
        let mut foo = arena.block_with_size_and_tag(2, 0);
        arena.set_field(&mut foo, 0, Value::int(0));
        arena.set_field(&mut foo, 1, Value::int(42));
        foo.build()
    };

    let bar = {
        let mut bar = arena.block_with_size_and_tag(2, 0);
        arena.set_field(&mut bar, 0, foo);
        arena.set_field(&mut bar, 1, Value::int(0));
        bar.build()
    };

    let err = Bar::from_ocamlrep(bar).err().unwrap();
    assert_eq!(
        err,
        ErrorInField(0, Box::new(ErrorInField(1, Box::new(ExpectedBool(42)))))
    );
}

#[derive(FromOcamlRep, ToOcamlRep)]
struct UnitStruct;

#[test]
fn expected_unit_struct_but_got_nonzero() {
    let value = Value::int(42);
    let err = UnitStruct::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, ExpectedUnit(42));
}

#[test]
fn expected_unit_struct_but_got_block() {
    let arena = Arena::new();
    let value = arena.block_with_size_and_tag(1, 0).build();
    let err = UnitStruct::from_ocamlrep(value).err().unwrap();
    match err {
        ExpectedInt(..) => {}
        _ => panic!("unexpected error: {}", err),
    }
}

#[derive(FromOcamlRep, ToOcamlRep)]
struct WrapperStruct(bool);

#[test]
fn bad_value_in_wrapper_struct() {
    let value = Value::int(42);
    let err = WrapperStruct::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, ExpectedBool(42))
}

#[derive(Debug, PartialEq, FromOcamlRep, ToOcamlRep)]
enum Fruit {
    Apple,
    Orange(bool),
    Pear { is_tasty: bool },
    Kiwi,
    Peach(Box<(isize, bool)>),
}

#[test]
fn nullary_variant_tag_out_of_range() {
    let value = Value::int(42);
    let err = Fruit::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, NullaryVariantTagOutOfRange { max: 1, actual: 42 });
}

#[test]
fn block_variant_tag_out_of_range() {
    let arena = Arena::new();
    let value = arena.block_with_size_and_tag(1, 42).build();
    let err = Fruit::from_ocamlrep(value).err().unwrap();
    assert_eq!(err, BlockTagOutOfRange { max: 2, actual: 42 });
}

#[test]
fn wrong_block_variant_size() {
    let arena = Arena::new();
    let value = arena.block_with_size_and_tag(42, 0).build();
    let err = Fruit::from_ocamlrep(value).err().unwrap();
    assert_eq!(
        err,
        WrongBlockSize {
            expected: 1,
            actual: 42
        }
    );
}

#[test]
fn bad_tuple_variant_value() {
    let arena = Arena::new();
    let orange = {
        let mut orange = arena.block_with_size_and_tag(1, 0);
        arena.set_field(&mut orange, 0, Value::int(42));
        orange.build()
    };
    let err = Fruit::from_ocamlrep(orange).err().unwrap();
    assert_eq!(err, ErrorInField(0, Box::new(ExpectedBool(42))));
}

#[test]
fn bad_struct_variant_value() {
    let arena = Arena::new();
    let pear = {
        let mut pear = arena.block_with_size_and_tag(1, 1);
        arena.set_field(&mut pear, 0, Value::int(42));
        pear.build()
    };
    let err = Fruit::from_ocamlrep(pear).err().unwrap();
    assert_eq!(err, ErrorInField(0, Box::new(ExpectedBool(42))));
}

#[test]
fn good_boxed_tuple_variant() {
    let arena = Arena::new();
    let peach = {
        let mut peach = arena.block_with_size_and_tag(2, 2);
        arena.set_field(&mut peach, 0, Value::int(42));
        arena.set_field(&mut peach, 1, Value::int(1));
        peach.build()
    };
    let peach = Fruit::from_ocamlrep(peach);
    assert_eq!(peach, Ok(Fruit::Peach(Box::new((42, true)))));
}

#[test]
fn round_trip_through_ocaml_value_unsigned_int() {
    let num = 7334234036144964024u64;
    let value = Value::int(num as isize);
    let num_int: isize = ocamlrep::from::expect_int(value).ok().unwrap();
    let num_uint: usize =
        !(1usize << 63) & ocamlrep::from::expect_int(value).ok().unwrap() as usize;

    assert!(num_int < 0);
    assert_eq!((num_int as u64) & !(1 << 63), num);
    assert_eq!(num_uint as u64, num);
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

#![cfg(test)]

use std::fmt::Debug;

use bumpalo::Bump;
use ocamlrep::FromOcamlRepIn;
use ocamlrep::ToOcamlRep;

fn test_round_trip<'a, T>(bump: &'a Bump, rust_value: T)
where
    T: FromOcamlRepIn<'a> + ToOcamlRep + Debug + PartialEq,
{
    let arena = ocamlrep::Arena::new();
    let ocaml_value = arena.add(&rust_value);
    assert_eq!(T::from_ocamlrep_in(ocaml_value, bump), Ok(rust_value));
}

#[test]
fn convert_primitives() {
    let bump = &Bump::new();

    test_round_trip(bump, ());
    test_round_trip(bump, 1isize);
    test_round_trip(bump, 2usize);
    test_round_trip(bump, 3i64);
    test_round_trip(bump, 4u64);
    test_round_trip(bump, 5i32);
    test_round_trip(bump, 6u32);
    test_round_trip(bump, true);
    test_round_trip(bump, false);
    test_round_trip(bump, 'a');
    test_round_trip(bump, 7.7f64);
}

#[test]
fn convert_std_types() {
    let bump = &Bump::new();

    test_round_trip(bump, None::<usize>);
    test_round_trip(bump, Some(&*bump.alloc(5usize)));
    test_round_trip(bump, Ok::<&str, &str>("okay"));
    test_round_trip(bump, Err::<&str, &str>("error"));
}

#[derive(Debug, FromOcamlRepIn, ToOcamlRep, PartialEq)]
struct Foo<'a> {
    bar: &'a usize,
    baz: usize,
}

#[test]
fn convert_struct_with_ref() {
    let bump = &Bump::new();
    test_round_trip(
        bump,
        Foo {
            bar: bump.alloc(3),
            baz: 4,
        },
    );
}

#[derive(Debug, FromOcamlRepIn, ToOcamlRep, PartialEq)]
enum Fruit<'a> {
    Apple,
    Orange(&'a str),
    Pear { is_tasty: bool },
    Kiwi,
    Peach(&'a (isize, bool)),
}

#[test]
fn convert_str_variant() {
    test_round_trip(&Bump::new(), Fruit::Orange("mandarin"));
}

#[test]
fn convert_boxed_tuple_variant() {
    let bump = &Bump::new();
    test_round_trip(bump, Fruit::Peach(bump.alloc((42, true))));
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

use ocamlrep::*;
use ocamlrep_custom::CustomOperations;
use serde::Deserialize;
use serde::Serialize;

/// Communicates that when the wrapped i64 is converted to an OCaml
/// representation, the type `Int64.t` (representing a boxed 64-bit integer)
/// should be used rather than the type `int` (which, on 64-bit architectures,
/// is an unboxed 63-bit integer).
#[derive(Clone, Copy, Debug, Eq, Hash, Ord, PartialEq, PartialOrd)]
#[derive(Serialize, Deserialize)]
pub struct Int64(pub i64);

extern "C" {
    static mut caml_int64_ops: CustomOperations;
}

impl From<i64> for Int64 {
    fn from(x: i64) -> Self {
        Self(x)
    }
}

impl From<Int64> for i64 {
    fn from(x: Int64) -> i64 {
        x.0
    }
}

impl ToOcamlRep for Int64 {
    fn to_ocamlrep<'a, A: Allocator>(&'a self, alloc: &'a A) -> Value<'a> {
        let mut block = alloc.block_with_size_and_tag(2, CUSTOM_TAG);
        alloc.set_field(&mut block, 0, unsafe {
            Value::from_bits((&caml_int64_ops) as *const CustomOperations as usize)
        });
        alloc.set_field(&mut block, 1, unsafe { Value::from_bits(self.0 as usize) });
        block.build()
    }
}

impl FromOcamlRep for Int64 {
    fn from_ocamlrep(value: Value<'_>) -> Result<Self, FromError> {
        let block = from::expect_block_with_size_and_tag(value, 2, CUSTOM_TAG)?;
        Ok(Self(block[1].to_bits() as i64))
    }
}

impl<'a> FromOcamlRepIn<'a> for Int64 {
    fn from_ocamlrep_in(value: Value<'_>, _alloc: &'a ocamlrep::Bump) -> Result<Self, FromError> {
        Self::from_ocamlrep(value)
    }
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

//! Library to build `Custom_tag` OCaml values.

use std::ffi::CStr;
use std::ffi::CString;
use std::mem::MaybeUninit;
use std::ops::Deref;
use std::os::raw::c_char;
use std::os::raw::c_int;
use std::os::raw::c_void;
use std::rc::Rc;

use ocamlrep::from;
use ocamlrep::Allocator;
use ocamlrep::FromError;
use ocamlrep::FromOcamlRep;
use ocamlrep::ToOcamlRep;
use ocamlrep::Value;
use ocamlrep::CUSTOM_TAG;
use ocamlrep_ocamlpool::catch_unwind;

extern "C" {
    fn caml_register_custom_operations(ops: *const CustomOperations);
    fn caml_serialize_block_1(data: *const u8, len: usize);
    fn caml_serialize_int_8(x: i64);
    fn caml_deserialize_sint_8() -> i64;
    fn caml_deserialize_block_1(data: *mut u8, len: usize);
}

/// Struct containing the operations for a custom OCaml block.
///
/// This is the Rust encoding of OCaml's `struct custom_operations`.
///
/// For more information on the fields see
/// [the OCaml guide](https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html#ss:c-custom-ops)
#[repr(C)]
pub struct CustomOperations {
    identifier: *const c_char,
    finalize: Option<extern "C" fn(usize) -> ()>,
    compare: Option<extern "C" fn(usize, usize) -> c_int>,
    hash: Option<extern "C" fn(usize) -> isize>,
    serialize: Option<extern "C" fn(usize, *mut usize, *mut usize) -> ()>,
    deserialize: Option<extern "C" fn(*mut c_void) -> usize>,
    compare_ext: Option<extern "C" fn(usize, usize) -> c_int>,

    /// Not implemented yet, always set to NULL.
    custom_fixed_length: *const c_void,
}

impl CustomOperations {
    /// Create a new custom block with the given identifier.
    ///
    /// All function pointers will be set to NULL by default.
    fn new(identifier: &'static CStr) -> Self {
        Self {
            identifier: identifier.as_ptr(),
            finalize: None,
            compare: None,
            hash: None,
            serialize: None,
            deserialize: None,
            compare_ext: None,
            custom_fixed_length: std::ptr::null(),
        }
    }
}

/// A wrapper around a Rust type that allows it
/// to be written into/read from OCaml memory and managed by
/// the OCaml GC.
///
/// The value still lives on the Rust heap in an `Rc`'d pointer,
/// and the `Rc`-pointer itself will be written to OCaml memory.
///
/// # Examples
///
/// Expose Rust type:
///
/// ```rust
/// use ocamlrep_custom::caml_serialize_default_impls;
/// use ocamlrep_custom::{CamlSerialize, Custom};
/// use ocamlrep_ocamlpool::ocaml_ffi;
/// use std::cell::Cell;
///
/// pub struct Counter(Cell<isize>);
///
/// impl CamlSerialize for Counter {
///     caml_serialize_default_impls!();
/// }
///
/// ocaml_ffi! {
///     fn counter_new() -> Custom<Counter> {
///         Custom::from(Counter(Cell::new(0)))
///     }
///
///     fn counter_inc(counter: Custom<Counter>) -> Custom<Counter> {
///         counter.0.set(counter.0.get() - 1);
///         counter
///     }
///
///     fn counter_read(counter: Custom<Counter>) -> isize {
///         counter.0.get()
///     }
/// }
/// ```
///
/// From OCaml:
///
/// ```ocaml
/// type counter; (* abstract type *)
///
/// external counter_new : unit -> counter = "counter_new"
/// external counter_inc: counter -> unit = "counter_inc"
/// external counter_read : counter -> isize = "counter_read"
///
/// let () =
///   let cnt = counter_new () in (* will be dropped on GC finalization *)
///   assert (counter_read cnt == 0);
///   counter_inc cnt;
///   assert (counter_read cnt == 1)
/// ```
pub struct Custom<T: CamlSerialize>(Rc<T>);

impl<T: CamlSerialize> Custom<T> {
    /// Create a new `ToCustom` wrapper by taking ownership of the value.
    pub fn from(x: T) -> Self {
        Self::new(Rc::new(x))
    }

    /// Create a new `ToCustom` directly from an `Rc`'d value.
    pub fn new(x: Rc<T>) -> Self {
        Self(x)
    }

    /// Get a reference to the inner `Rc`
    pub fn inner(&self) -> &Rc<T> {
        &self.0
    }
}

impl<T: CamlSerialize> Deref for Custom<T> {
    type Target = T;
    fn deref(&self) -> &T {
        self.0.deref()
    }
}

/// A custom block has two words: a pointer to the CustomOperations struct,
/// and a pointer the the value. Our values are ref-counted, but an Rc pointer
/// is just pointer-sized.
#[repr(C)]
struct CustomBlockOcamlRep<T>(&'static CustomOperations, Rc<T>);

const CUSTOM_BLOCK_SIZE_IN_BYTES: usize = std::mem::size_of::<CustomBlockOcamlRep<()>>();
const CUSTOM_BLOCK_SIZE_IN_WORDS: usize =
    CUSTOM_BLOCK_SIZE_IN_BYTES / std::mem::size_of::<Value<'_>>();

impl<T: CamlSerialize> ToOcamlRep for Custom<T> {
    fn to_ocamlrep<'a, A: Allocator>(&'a self, alloc: &'a A) -> Value<'a> {
        let ops: &'static CustomOperations = <T as CamlSerialize>::operations();

        let mut block = alloc.block_with_size_and_tag(CUSTOM_BLOCK_SIZE_IN_WORDS, CUSTOM_TAG);

        // Safety: we don't call any method on `alloc` after this method.
        let block_ptr: *mut Value<'_> = unsafe { alloc.block_ptr_mut(&mut block) };

        // Safety: `alloc` guarantees that the `block_ptr` returned by
        // `block_ptr_mut` is aligend to `align_of::<Value>()` and valid
        // for reads and writes of `CUSTOM_BLOCK_SIZE_IN_WORDS *
        // size_of::<Value>()` bytes. Since `CustomBlockOcamlRep` has size
        // `CUSTOM_BLOCK_SIZE_IN_WORDS * size_of::<Value>()`, its
        // alignment is equal to `align_of::<Value>()`, and no other
        // reference to our newly-allocated block can exist, it's safe for us to
        // interpret `block_ptr` as a `&mut CustomBlockOcamlRep`.
        let block_ptr = block_ptr as *mut MaybeUninit<CustomBlockOcamlRep<T>>;
        let custom_block = unsafe { block_ptr.as_mut().unwrap() };

        // Write the address of the operations struct to the first word, and the
        // pointer to the value to the second word.
        *custom_block = MaybeUninit::new(CustomBlockOcamlRep(ops, Rc::clone(&self.0)));

        block.build()
    }
}

impl<T: CamlSerialize> FromOcamlRep for Custom<T> {
    fn from_ocamlrep(value: Value<'_>) -> Result<Self, FromError> {
        let rc = rc_from_value::<T>(value)?;
        let rc = Rc::clone(rc);

        Ok(Custom::new(rc))
    }
}

/// Helper function to fetch a reference to the `Rc` from the OCaml representation
/// of a custom block.
fn rc_from_value<'a, T: CamlSerialize>(value: Value<'a>) -> Result<&'a Rc<T>, FromError> {
    let block = from::expect_block(value)?;
    from::expect_block_tag(block, CUSTOM_TAG)?;
    from::expect_block_size(block, CUSTOM_BLOCK_SIZE_IN_WORDS)?;

    // We still don't know whether this block is in fact a
    // CustomBlockOcamlRep<T>--it may be a CustomBlockOcamlRep<U>, or some
    // other custom block which happens to be the same size. We can verify
    // that the block is actually a CustomBlockOcamlRep<T> by checking that
    // it points to the correct CustomOperations struct.
    let ops = <T as CamlSerialize>::operations();
    if !std::ptr::eq(ops, block[0].to_bits() as *const CustomOperations) {
        return Err(FromError::UnexpectedCustomOps {
            expected: ops as *const _ as usize,
            actual: block[0].to_bits(),
        });
    }

    let value_ptr = value.to_bits() as *const CustomBlockOcamlRep<T>;

    // Safety: `value_ptr` is guaranteed to be aligned to
    // `align_of::<Value>()`, and our use of `expect_block_size` guarantees
    // that the pointer is valid for reads of `CUSTOM_BLOCK_SIZE_IN_WORDS *
    // `size_of::<Value>()` bytes. Since the first field points to the right
    // operations struct, we either have a valid `CustomBlockOCamlRep<T>`
    // (i.e., constructed above in our `ToOcamlRep` implementation) or
    // someone went out of their way to construct an invalid one. Assume
    // it's valid and read in the `CustomBlockOcamlRep<T>`.
    let custom_block = unsafe { value_ptr.as_ref().unwrap() };
    Ok(&custom_block.1)
}

/// Trait that allows OCaml serialization and deserialization.
///
/// If you want to support serialization/deserialization, you
/// **MUST** call `CamlSerialize::register()` when starting up
/// the program.
///
/// This will register your type in the OCaml runtime, allowing
/// deserialization.
///
/// Rust does not support different instantiations of the default
/// implementation for different implementors of trait types. Therefore,
/// you must implement `type_identifier`, `operations` and `register`
/// manually when implementing this trait for a type. You can use
/// the `caml_serialize_default_impls!()` to do that automatically:
///
/// ```
/// impl CamlSerialize for MyType {
///    caml_serialize_default_impls!();
/// }
/// ```
pub trait CamlSerialize: Sized {
    /// Get the type name.
    fn type_identifier() -> &'static CStr;

    /// Get the type's custom operations struct.
    ///
    /// Always has to return the same reference! If not, the
    /// OCaml-to-Rust conversion will fail.
    ///
    /// The returned structure is not intended to be used by
    /// a programmer. Using it directly by e.g. injecting it
    /// into OCaml custom blocks is dangerous and can cause
    /// undefined behavior. Don't do it!
    fn operations() -> &'static CustomOperations;

    /// Register the type with the OCaml system.
    ///
    /// # Safety
    ///
    /// Must not be called from multiple threads.
    ///
    /// This function interacts with the OCaml runtime, which is not thread-safe.
    /// If any other threads are attempting to interact with the OCaml runtime
    /// or its custom operations table (e.g., by invoking this function, or by
    /// executing OCaml code using custom blocks) when this function is invoked,
    /// undefined behavior will result.
    ///
    /// # Examples
    ///
    /// ```
    /// use ocamlrep_custom::CamlSerialize;
    /// use ocamlrep_ocamlpool::ocaml_ffi;
    ///
    /// struct IntBox(isize);
    ///
    /// impl CamlSerialize for IntBox {
    ///     caml_serialize_default_impls!();
    ///     fn serialize(&self) -> Vec<u8> { ... }
    ///     fn deserialize(buffer: &[u8]) -> Self { ... }
    /// }
    ///
    /// ocaml_ffi! {
    ///     fn register_custom_types() {
    ///         // Once `register_custom_types` has been invoked from OCaml, IntBox
    ///         // can be serialized and deserialized from OCaml using the Marshal
    ///         // module.
    ///         //
    ///         // Safety: this will be called from OCaml, as such nothing else will
    ///         // be interacting with the OCaml runtime.
    ///         unsafe { IntBox::register() };
    ///     }
    /// }
    /// ```
    unsafe fn register();

    /// Convert a value to an array of bytes.
    ///
    /// The default implementation panics.
    fn serialize(&self) -> Vec<u8> {
        panic!(
            "serialization not implemented for {:?}",
            Self::type_identifier()
        )
    }

    /// Deserialize a value form an array of bytes.
    ///
    /// The default implementation panics.
    fn deserialize(_data: &[u8]) -> Self {
        panic!(
            "deserialization not implemented for {:?}",
            Self::type_identifier()
        )
    }
}

#[macro_export]
macro_rules! caml_serialize_default_impls {
    () => {
        fn type_identifier() -> &'static std::ffi::CStr {
            static ONCE: std::sync::Once = std::sync::Once::new();
            static mut TYPE_NAME: Option<std::ffi::CString> = None;

            ONCE.call_once(|| {
                // Safety:
                // - We've gated initialization, so it's thread safe.
                // - We only set the constant once.
                unsafe {
                    TYPE_NAME = Some($crate::type_identifier_helper::<Self>());
                }
            });

            // Safety:
            // - By now the constant has been initialized, and once initialized
            //   it is never changes.
            // - Concurrent reads are OK.
            unsafe { TYPE_NAME.as_ref().unwrap() }
        }

        fn operations() -> &'static $crate::CustomOperations {
            static ONCE: std::sync::Once = std::sync::Once::new();
            static mut OPS_STRUCT: Option<$crate::CustomOperations> = None;

            ONCE.call_once(|| {
                // Safety:
                // - We've gated initialization, so it's thread safe.
                // - We only set the constant once.
                unsafe {
                    OPS_STRUCT = Some($crate::operations_helper::<Self>());
                }
            });

            // Safety:
            // - By now the constant has been initialized, and once initialized
            //   it is never changes.
            // - Concurrent reads are OK.
            unsafe { OPS_STRUCT.as_ref().unwrap() }
        }

        unsafe fn register() {
            static mut IS_REGISTERED: bool = false;

            // Safety: Can only be called in a single-threaded context!
            if IS_REGISTERED {
                return;
            }
            IS_REGISTERED = true;

            let ops = Self::operations();
            $crate::register_helper::<Self>(ops)
        }
    };
}

/// Helper used for the `caml_serialize_default_impls` macro
pub fn type_identifier_helper<T>() -> CString {
    let name = format!("ocamlrep.custom.{}", std::any::type_name::<T>());
    std::ffi::CString::new(name).unwrap()
}

/// Helper used for the `caml_serialize_default_impls` macro
pub fn operations_helper<T: CamlSerialize>() -> CustomOperations {
    let type_identifier = <T as CamlSerialize>::type_identifier();
    let mut ops = CustomOperations::new(type_identifier);
    ops.finalize = Some(drop_value::<T>);
    ops.serialize = Some(serialize_value::<T>);
    ops.deserialize = Some(deserialize_value::<T>);
    ops
}

/// Helper used for the `caml_serialize_default_impls` macro
///
/// Should not be used directly. Interacts with the OCaml runtime and is
/// thus unsafe to call in a multi-threaded context.
pub unsafe fn register_helper<T>(ops: &'static CustomOperations) {
    // Safety: operations struct has a static lifetime, it will live forever!
    caml_register_custom_operations(ops as *const CustomOperations);
}

/// Helper function used by `operations_helper`. Returns a finalizer for custom
/// blocks containing an `Rc<T>`.
extern "C" fn drop_value<T: CamlSerialize>(value: usize) {
    let _: usize = catch_unwind(|| {
        // Safety: We trust here that CustomOperations structs containing this
        // `drop_value` instance will only ever be referenced by custom blocks
        // matching the layout of `CustomBlockOcamlRep`. If that's so, then this
        // function should only be invoked by the OCaml runtime on a pointer to
        // a CustomBlockOcamlRep<T> created by T::to_ocamlrep. Such a pointer
        // would be aligned and valid.
        let custom_block_ptr = value as *mut CustomBlockOcamlRep<T>;
        let custom_block = unsafe { custom_block_ptr.as_mut().unwrap() };

        // The `Rc` will be dropped here, and its reference count will decrease
        // by one (possibly freeing the referenced value).

        // Safety: Since the OCaml runtime will only invoke the finalizer for a
        // value which will never again be used, it is safe to use
        // `drop_in_place` (i.e., our finalizer will only be invoked once, so we
        // won't cause a double-drop).
        unsafe {
            std::ptr::drop_in_place(&mut custom_block.1);
        }

        0
    });
}

/// Helper function for serialization. Interacts with the OCaml runtime, so must
/// only be invoked by the OCaml runtime when serializing a custom block.
extern "C" fn serialize_value<T: CamlSerialize>(
    value: usize,
    bsize_32: *mut usize,
    bsize_64: *mut usize,
) {
    let _: usize = catch_unwind(|| {
        // Safety: Only called by the OCaml runtime (we don't expose a means of
        // invoking this function from Rust), which provides some OCaml
        // CUSTOM_TAG block as the value.
        let value = unsafe { Value::from_bits(value) };

        // Only called by the OCaml runtime, when serializing
        // a Custom-object managed by the OCaml GC.
        let rc = rc_from_value::<T>(value).unwrap();

        let bytes: Vec<u8> = rc.serialize();
        let bytes_ptr = bytes.as_ptr();

        // Safety: As above, we don't expose a means of invoking this function
        // from Rust--it can only be invoked by the OCaml runtime while
        // serializing a value. It is safe to invoke OCaml serialization
        // functions in this context.
        unsafe {
            let len = bytes.len();
            caml_serialize_int_8(len.try_into().unwrap());
            caml_serialize_block_1(bytes_ptr, len);

            // The size taken up in the data-part of the custom block.
            *bsize_32 = std::mem::size_of::<u32>();
            *bsize_64 = std::mem::size_of::<u64>();
        }

        0
    });
}

/// Helper function for deserialization. Interacts with the OCaml runtime, so must
/// only be invoked by the OCaml runtime when serializing a custom block.
extern "C" fn deserialize_value<T: CamlSerialize>(data_ptr: *mut c_void) -> usize {
    catch_unwind(|| {
        // Get the serialized bytes from the input channel.
        let bytes = unsafe {
            // Safety: We don't expose a means of invoking this function from
            // Rust--`deserialize_value` can only be invoked by the OCaml
            // runtime while deserializing a custom block value. It is safe to
            // invoke OCaml deserialization functions in this context.
            let len: usize = caml_deserialize_sint_8().try_into().unwrap();

            let mut buf: Vec<u8> = Vec::with_capacity(len);

            // Safety: len <= capacity. The elements aren't initialized at this
            // time, but we trust that caml_deserialize_block_1 will fill `len`
            // bytes of the buffer.
            #[allow(clippy::uninit_vec)]
            buf.set_len(len);

            // Safety: As above, `deserialize_value` can only be invoked by the
            // OCaml runtime during custom block deserialization.
            caml_deserialize_block_1(buf.as_mut_ptr(), len);
            buf
        };

        // Actually deserialize those bytes into a T.
        let val: T = CamlSerialize::deserialize(&bytes);

        // Safety: The OCaml runtime will give us a data buffer which is
        // usize-aligned and valid for reads and writes of bsize_32 or bsize_64
        // (as provided by `serialize_value`, above) bytes (depending on system
        // architecture). This is sufficient for `Rc<T>` (which has the size and
        // alignment of usize).
        let data_ptr = data_ptr as *mut MaybeUninit<Rc<T>>;
        let data = unsafe { data_ptr.as_mut().unwrap() };

        *data = MaybeUninit::new(Rc::new(val));

        // Return the size of the value we wrote to our output pointer. The
        // OCaml runtime will verify that it matches the expected
        // bsize_32/bsize_64 written by the serializer.
        std::mem::size_of_val(data)
    })
}

#[cfg(test)]
mod test {
    use std::mem::*;

    use super::*;

    #[test]
    fn custom_block_ocamlrep_size() {
        assert_eq!(
            size_of::<CustomBlockOcamlRep<u8>>(),
            2 * size_of::<Value<'_>>()
        );
    }

    #[test]
    fn custom_block_ocamlrep_align() {
        assert_eq!(
            align_of::<CustomBlockOcamlRep<u8>>(),
            align_of::<Value<'_>>()
        );
    }
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

#![feature(exit_status_error)]

use std::cell::Cell;

use ocamlrep_custom::caml_serialize_default_impls;
use ocamlrep_custom::CamlSerialize;
use ocamlrep_custom::Custom;
use ocamlrep_ocamlpool::ocaml_ffi;

pub struct Counter(Cell<isize>);

impl CamlSerialize for Counter {
    caml_serialize_default_impls!();
}

ocaml_ffi! {
    fn counter_new() -> Custom<Counter> {
        Custom::from(Counter(Cell::new(0)))
    }

    fn counter_inc(counter: Custom<Counter>) -> Custom<Counter> {
        counter.0.set(counter.0.get() + 1);
        counter
    }

    fn counter_read(counter: Custom<Counter>) -> isize {
        counter.0.get()
    }
}

// Hack! Trick buck into believing that these libraries are used. See [Note:
// Test blocks for Cargo] in `ocamlrep_ocamlpool/test/ocamlpool_test.rs`.
const _: () = {
    #[allow(unused_imports)]
    use anyhow;
    #[allow(unused_imports)]
    use cargo_test_utils;
    #[allow(unused_imports)]
    use tempdir;
};

#[cfg(test)]
mod tests {
    use anyhow::Result;
    use cargo_test_utils::*;
    use tempdir::TempDir;

    #[test]
    fn counter_test() -> Result<()> {
        let tmp_dir = TempDir::new("ocamlrep_custom_test")?;
        std::fs::copy(
            "counter_client.ml",
            tmp_dir.path().join("counter_client.ml"),
        )?;
        let compile_cmd = cmd(
            "ocamlopt.opt",
            &[
                "-verbose",
                "-c",
                "counter_client.ml",
                "-o",
                "counter_client_ml.cmx",
            ],
            Some(tmp_dir.path()),
        );
        assert_eq!(run(compile_cmd).map_err(fmt_exit_status_err), Ok(()));
        let link_cmd = cmd(
            "ocamlopt.opt",
            &[
                "-verbose",
                "-o",
                "counter_test",
                "counter_client_ml.cmx",
                "-ccopt",
                &("-L".to_owned() + workspace_dir(&["target", build_flavor()]).to_str().unwrap()),
                "-cclib",
                "-lcounter",
                "-cclib",
                "-locamlrep_ocamlpool",
            ],
            Some(tmp_dir.path()),
        );
        assert_eq!(run(link_cmd).map_err(fmt_exit_status_err), Ok(()));
        let counter_test_cmd = cmd(
            tmp_dir
                .path()
                .join("counter_test")
                .as_path()
                .to_str()
                .unwrap(),
            &[],
            None,
        );
        assert_eq!(run(counter_test_cmd).map_err(fmt_exit_status_err), Ok(()));
        tmp_dir.close()?;
        Ok(())
    }
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

use std::cell::RefCell;
use std::io::Write;
use std::rc::Rc;

use ocamlrep_custom::caml_serialize_default_impls;
use ocamlrep_custom::CamlSerialize;
use ocamlrep_custom::Custom;
use ocamlrep_ocamlpool::ocaml_ffi;

struct DropTest(Rc<RefCell<bool>>);

impl CamlSerialize for DropTest {
    caml_serialize_default_impls!();
}

struct DropTestCell(Rc<RefCell<bool>>);

impl CamlSerialize for DropTestCell {
    caml_serialize_default_impls!();
}

impl DropTest {
    pub fn new() -> Self {
        Self(Rc::new(RefCell::new(false)))
    }

    pub fn cell(&self) -> Rc<RefCell<bool>> {
        self.0.clone()
    }
}

impl Drop for DropTest {
    fn drop(&mut self) {
        *self.0.borrow_mut() = true;
    }
}

ocaml_ffi! {
  fn test_custom_drop_test_new() -> Custom<DropTest> {
    Custom::from(DropTest::new())
  }

  fn test_custom_drop_test_custom_ref_count(x: Custom<DropTest>) -> usize {
    let w = Rc::downgrade(x.inner());
    drop(x);
    w.strong_count()
  }

  fn test_custom_drop_test_get_cell(x: Custom<DropTest>) -> Custom<DropTestCell> {
    Custom::from(DropTestCell(x.cell()))
  }

  fn test_custom_drop_test_cell_is_dropped(x: Custom<DropTestCell>) -> bool {
    *x.0.borrow()
  }
}

struct BoxedInt(isize);

impl CamlSerialize for BoxedInt {
    caml_serialize_default_impls!();

    fn serialize(&self) -> Vec<u8> {
        let mut buffer = Vec::new();
        buffer.write_all(&self.0.to_be_bytes()).unwrap();
        buffer
    }

    fn deserialize(buffer: &[u8]) -> Self {
        let i = isize::from_be_bytes(buffer[0..std::mem::size_of::<isize>()].try_into().unwrap());
        BoxedInt(i)
    }
}

ocaml_ffi! {
  fn test_custom_boxed_int_register() {
    // Safety: called from OCaml in a single-threaded context.
    unsafe {
      BoxedInt::register();
    }
  }

  fn test_custom_boxed_int_new(x: isize) -> Custom<BoxedInt> {
    Custom::from(BoxedInt(x))
  }

  fn test_custom_boxed_int_equal(x: Custom<BoxedInt>, y: Custom<BoxedInt>) -> bool {
    x.0 == y.0
  }
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

#![recursion_limit = "128"]

use proc_macro2::TokenStream;
use quote::quote;
use syn::Attribute;
use syn::Meta;
use syn::NestedMeta;
use synstructure::decl_derive;
use synstructure::BindingInfo;
use synstructure::VariantInfo;

// The rust_to_ocaml_attr crate provides the rust_to_ocaml attribute macro,
// which is intended to be consumed by the rust_to_ocaml codegen tool. It
// doesn't currently control the behavior of any derived ocamlrep trait impls.
//
// Unfortunately, rust_to_ocaml_attr does not strip the attribute macro from
// positions where attribute macros are not allowed (like field definitions).
// The easiest way to do that is to ask proc_macro_derive to do it, but that
// requires the use of a derive macro.
//
// Since all of the types we are interested in passing to rust_to_ocaml
// implement an ocamlrep trait, ask proc_macro_derive (via decl_derive) to strip
// rust_to_ocaml attributes when deriving ocamlrep traits.
//
// Even with this stripping, the rust_to_ocaml_attr crate is still required to
// strip the attribute from type aliases, which cannot use derive macros.
decl_derive!([ToOcamlRep, attributes(rust_to_ocaml, ocamlrep)] => derive_to_ocamlrep);
decl_derive!([FromOcamlRep, attributes(rust_to_ocaml, ocamlrep)] => derive_from_ocamlrep);
decl_derive!([FromOcamlRepIn, attributes(rust_to_ocaml, ocamlrep)] => derive_from_ocamlrep_in);

fn derive_to_ocamlrep(mut s: synstructure::Structure<'_>) -> TokenStream {
    // remove #[ocamlrep(skip)]
    for variant in s.variants_mut() {
        variant.filter(|bi| !has_ocamlrep_skip_attr(&bi.ast().attrs));
    }

    // By default, if you are deriving an impl of trait Foo for generic type
    // X<T>, synstructure will add Foo as a bound not only for the type
    // parameter T, but also for every type which appears as a field in X. This
    // is not necessary for our use case--we can just require that the type
    // parameters implement our trait.
    s.add_bounds(synstructure::AddBounds::Generics);

    let to_body = to_ocamlrep_body(&s);
    s.gen_impl(quote! {
        gen impl ::ocamlrep::ToOcamlRep for @Self {
            fn to_ocamlrep<'__ocamlrep_derive_allocator, Alloc: ::ocamlrep::Allocator>(
                &'__ocamlrep_derive_allocator self,
                arena: &'__ocamlrep_derive_allocator Alloc,
            ) -> ::ocamlrep::Value<'__ocamlrep_derive_allocator> {
                use ::ocamlrep::Allocator;
                match self { #to_body }
            }
        }
    })
}

fn derive_from_ocamlrep(mut s: synstructure::Structure<'_>) -> TokenStream {
    s.add_bounds(synstructure::AddBounds::Generics);

    let from_body = from_ocamlrep_body(&mut s);
    s.gen_impl(quote! {
        gen impl ::ocamlrep::FromOcamlRep for @Self {
            fn from_ocamlrep(value: ::ocamlrep::Value<'_>) -> ::std::result::Result<Self, ::ocamlrep::FromError> {
                use ::ocamlrep::FromOcamlRep;
                #from_body
            }
        }
    })
}

fn derive_from_ocamlrep_in(mut s: synstructure::Structure<'_>) -> TokenStream {
    s.add_bounds(synstructure::AddBounds::Generics);

    if s.ast().generics.lifetimes().next().is_none() {
        s.add_bounds(synstructure::AddBounds::None);
        let tparams = s.ast().generics.type_params();
        let tparams_implement_from_ocamlrep: TokenStream = tparams
            .map(|t| quote!(#t : ::ocamlrep::FromOcamlRep,))
            .collect();
        let from_body = from_ocamlrep_body(&mut s);
        return s.gen_impl(quote! {
            gen impl<'__ocamlrep_derive_allocator> ::ocamlrep::FromOcamlRepIn<'__ocamlrep_derive_allocator> for @Self
            where #tparams_implement_from_ocamlrep
            {
                fn from_ocamlrep_in(
                    value: ::ocamlrep::Value<'_>,
                    alloc: &'__ocamlrep_derive_allocator ::ocamlrep::Bump,
                ) -> ::std::result::Result<Self, ::ocamlrep::FromError> {
                    use ::ocamlrep::FromOcamlRep;
                    #from_body
                }
            }
        });
    }

    // Constrain the lifetime of `'__ocamlrep_derive_allocator` to be equal to
    // any declared lifetimes. This is so that we can reference the lifetime
    // parameter to `FromOcamlRepIn` without requiring implementors to use a
    // certain name for their lifetime parameter.
    let lifetimes = s.ast().generics.lifetimes();
    let lifetimes: TokenStream = lifetimes
        .map(|l| {
            quote! {
                '__ocamlrep_derive_allocator : #l,
                #l : '__ocamlrep_derive_allocator,
            }
        })
        .collect();
    let tparams = s.ast().generics.type_params();
    let tparams_implement_trivialdrop: TokenStream = tparams
        .map(|t| quote!(#t : ::arena_trait::TrivialDrop,))
        .collect();

    let from_in_body = from_ocamlrep_in_body(&mut s);
    s.gen_impl(quote! {
        gen impl<'__ocamlrep_derive_allocator> ::ocamlrep::FromOcamlRepIn<'__ocamlrep_derive_allocator> for @Self
        where
            #tparams_implement_trivialdrop #lifetimes
        {
            fn from_ocamlrep_in(
                value: ::ocamlrep::Value<'_>,
                alloc: &'__ocamlrep_derive_allocator ::ocamlrep::Bump,
            ) -> ::std::result::Result<Self, ::ocamlrep::FromError> {
                use ::ocamlrep::FromOcamlRepIn;
                #from_in_body
            }
        }
    })
}

fn to_ocamlrep_body(s: &synstructure::Structure<'_>) -> TokenStream {
    match &s.ast().data {
        syn::Data::Struct(struct_data) => struct_to_ocamlrep(s, struct_data),
        syn::Data::Enum(_) => enum_to_ocamlrep(s, collect_enum_variants(s)),
        syn::Data::Union(_) => panic!("untagged unions not supported"),
    }
}

fn from_ocamlrep_body(s: &mut synstructure::Structure<'_>) -> TokenStream {
    match &s.ast().data {
        syn::Data::Struct(struct_data) => struct_from_ocamlrep(s, struct_data, false),
        syn::Data::Enum(_) => enum_from_ocamlrep(collect_enum_variants(s), false),
        syn::Data::Union(_) => panic!("untagged unions not supported"),
    }
}

fn from_ocamlrep_in_body(s: &mut synstructure::Structure<'_>) -> TokenStream {
    match &s.ast().data {
        syn::Data::Struct(struct_data) => struct_from_ocamlrep(s, struct_data, true),
        syn::Data::Enum(_) => enum_from_ocamlrep(collect_enum_variants(s), true),
        syn::Data::Union(_) => panic!("untagged unions not supported"),
    }
}

fn struct_to_ocamlrep(
    s: &synstructure::Structure<'_>,
    struct_data: &syn::DataStruct,
) -> TokenStream {
    match struct_data.fields {
        syn::Fields::Unit => {
            // Represent unit structs with unit.
            s.each_variant(|_| quote! { arena.add(&()) })
        }
        syn::Fields::Unnamed(ref fields) if fields.unnamed.len() == 1 => {
            // For the newtype pattern (a tuple struct with a single field),
            // don't allocate a block--just use the inner value directly.
            s.each(|bi| quote! { arena.add(#bi) })
        }
        syn::Fields::Named(_) | syn::Fields::Unnamed(_) => {
            // Otherwise, we have a record-like struct or a tuple struct. Both
            // are represented with a block.
            s.each_variant(|v| allocate_block(v, 0))
        }
    }
}

/// Fetch all the parameters from ocamlrep attributes:
///   #[ocamlrep(foo, bar), ocamlrep(baz)]
/// yields:
///   [foo, bar, baz]
fn parse_ocamlrep_attr(attrs: &[Attribute]) -> Option<Vec<NestedMeta>> {
    let mut res = None;
    for attr in attrs {
        let meta = attr.parse_meta().unwrap();
        match meta {
            Meta::Path(_) => {
                // #[foo]
            }
            Meta::List(list) => {
                // #[foo(bar)]
                if list.path.is_ident("ocamlrep") {
                    res.get_or_insert_with(Vec::new)
                        .extend(list.nested.into_iter());
                }
            }
            Meta::NameValue(_) => {
                // #[foo = bar]
            }
        }
    }

    res
}

/// Returns true if the attributes contain an `#[ocamlrep(skip)]`
fn has_ocamlrep_skip_attr(attrs: &[Attribute]) -> bool {
    if let Some(ocamlrep) = parse_ocamlrep_attr(attrs) {
        for rep in ocamlrep {
            match rep {
                NestedMeta::Meta(Meta::Path(path)) if path.is_ident("skip") => {
                    return true;
                }
                _ => {}
            }
        }
    }

    false
}

fn struct_from_ocamlrep(
    s: &mut synstructure::Structure<'_>,
    struct_data: &syn::DataStruct,
    from_in: bool,
) -> TokenStream {
    let variant = &mut s.variants_mut()[0];
    match struct_data.fields {
        syn::Fields::Unit => {
            let constructor = variant.construct(|_, _| quote!(unreachable!()));
            quote! { <()>::from_ocamlrep(value)?; Ok(#constructor) }
        }
        syn::Fields::Unnamed(ref fields) if fields.unnamed.len() == 1 => {
            let constructor = variant.construct(|field, _| {
                let ty = &field.ty;
                if from_in {
                    quote! { <#ty>::from_ocamlrep_in(value, alloc)? }
                } else {
                    quote! { <#ty>::from_ocamlrep(value)? }
                }
            });
            quote! { Ok(#constructor) }
        }
        syn::Fields::Named(_) | syn::Fields::Unnamed(_) => {
            let mut binding = 0;
            let constructor = variant.construct(|field, _| {
                if has_ocamlrep_skip_attr(&field.attrs) {
                    quote!(::std::default::Default::default())
                } else {
                    let idx = binding;
                    binding += 1;
                    field_constructor(idx, from_in)
                }
            });
            quote! {
                let block = ::ocamlrep::from::expect_tuple(value, #binding)?;
                Ok(#constructor)
            }
        }
    }
}

struct EnumVariants<'a> {
    nullary_variants: Vec<(&'a synstructure::VariantInfo<'a>, isize)>,
    block_variants: Vec<(&'a synstructure::VariantInfo<'a>, isize)>,
}

fn collect_enum_variants<'a>(s: &'a synstructure::Structure<'_>) -> EnumVariants<'a> {
    // For tagging purposes, variant constructors of zero arguments are numbered
    // separately from variant constructors of one or more arguments, so we need
    // to count them separately to learn their tags.
    let mut nullary_variants = vec![];
    let mut block_variants = vec![];
    for variant in s.variants().iter() {
        if variant.bindings().is_empty() {
            nullary_variants.push((variant, nullary_variants.len() as isize));
        } else {
            block_variants.push((variant, block_variants.len() as isize));
        };
    }
    // Block tags larger than this value indicate specific OCaml types (and tags
    // larger than 255 wouldn't fit in a u8 anyway).
    // See https://github.com/ocaml/ocaml/blob/3.08/utils/config.mlp#L55
    assert!(
        block_variants.len() <= 246,
        "Too many non-constant enum variants -- maximum is 246"
    );
    EnumVariants {
        nullary_variants,
        block_variants,
    }
}

fn enum_to_ocamlrep(s: &synstructure::Structure<'_>, variants: EnumVariants<'_>) -> TokenStream {
    let EnumVariants {
        nullary_variants,
        mut block_variants,
    } = variants;
    let mut all_variants = nullary_variants;
    all_variants.append(&mut block_variants);
    s.each_variant(|v| {
        let size = v.bindings().len();
        let tag = {
            all_variants
                .iter()
                .find(|(var, _)| *var == v)
                .map(|(_, tag)| *tag)
                .unwrap()
        };
        if size == 0 {
            quote!(::ocamlrep::Value::int(#tag))
        } else {
            let tag = tag as u8;
            match get_boxed_tuple_len(v) {
                None => allocate_block(v, tag),
                Some(len) => boxed_tuple_variant_to_block(&v.bindings()[0], tag, len),
            }
        }
    })
}

fn enum_from_ocamlrep(variants: EnumVariants<'_>, from_in: bool) -> TokenStream {
    let EnumVariants {
        nullary_variants,
        block_variants,
    } = variants;
    let max_nullary_tag = nullary_variants.len().saturating_sub(1);
    let max_block_tag = block_variants.len().saturating_sub(1) as u8;

    let mut nullary_arms = TokenStream::new();
    for (variant, tag) in nullary_variants.iter() {
        let constructor = variant.construct(|_, _| quote!(unreachable!()));
        nullary_arms.extend(quote! { #tag => Ok(#constructor), });
    }
    nullary_arms.extend(quote! {
        tag => Err(::ocamlrep::FromError::NullaryVariantTagOutOfRange {
            max: #max_nullary_tag,
            actual: tag,
        })
    });

    let mut block_arms = TokenStream::new();
    for (variant, tag) in block_variants.iter() {
        let tag = *tag as u8;
        let (size, constructor) = match get_boxed_tuple_len(variant) {
            None => (
                variant.bindings().len(),
                variant.construct(|_, i| field_constructor(i, from_in)),
            ),
            Some(len) => (len, boxed_tuple_variant_constructor(variant, len, from_in)),
        };
        block_arms.extend(quote! { #tag => {
            ::ocamlrep::from::expect_block_size(block, #size)?;
            Ok(#constructor)
        } });
    }
    block_arms.extend(quote! {
        tag => Err(::ocamlrep::FromError::BlockTagOutOfRange {
            max: #max_block_tag,
            actual: tag,
        })
    });

    match (nullary_variants.is_empty(), block_variants.is_empty()) {
        // An enum with no variants is not instantiable.
        (true, true) => panic!("cannot derive OcamlRep for non-instantiable enum"),
        // Nullary variants only.
        (false, true) => quote! {
            match ::ocamlrep::from::expect_int(value)? { #nullary_arms }
        },
        // Block variants only.
        (true, false) => quote! {
            let block = ::ocamlrep::from::expect_block(value)?;
            match block.tag() { #block_arms }
        },
        // Both nullary and block variants.
        (false, false) => quote! {
            if value.is_int() {
                match value.as_int().unwrap() { #nullary_arms }
            } else {
                let block = value.as_block().unwrap();
                match block.tag() { #block_arms }
            }
        },
    }
}

fn allocate_block(variant: &VariantInfo<'_>, tag: u8) -> TokenStream {
    let size = variant.bindings().len();
    let mut fields = TokenStream::new();
    for (i, bi) in variant.bindings().iter().enumerate() {
        fields.extend(quote! {
            arena.set_field(&mut block, #i, arena.add(#bi));
        });
    }
    quote! {
        let mut block = arena.block_with_size_and_tag(#size, #tag);
        #fields
        block.build()
    }
}

fn boxed_tuple_variant_to_block(bi: &BindingInfo<'_>, tag: u8, len: usize) -> TokenStream {
    let mut fields = TokenStream::new();
    for i in 0..len {
        let idx = syn::Index::from(i);
        fields.extend(quote! {
            arena.set_field(&mut block, #i, arena.add(&#bi.#idx));
        });
    }
    quote! {
        let mut block = arena.block_with_size_and_tag(#len, #tag);
        #fields
        block.build()
    }
}

fn field_constructor(index: usize, from_in: bool) -> TokenStream {
    if from_in {
        quote! { ::ocamlrep::from::field_in(block, #index, alloc)? }
    } else {
        quote! { ::ocamlrep::from::field(block, #index)? }
    }
}

fn boxed_tuple_variant_constructor(
    variant: &VariantInfo<'_>,
    len: usize,
    from_in: bool,
) -> TokenStream {
    let mut ident = TokenStream::new();
    if let Some(prefix) = variant.prefix {
        ident.extend(quote!(#prefix ::));
    }
    let id = variant.ast().ident;
    ident.extend(quote!(#id));

    let mut fields = TokenStream::new();
    for idx in 0..len {
        fields.extend(if from_in {
            quote! { ::ocamlrep::from::field_in(block, #idx, alloc)?, }
        } else {
            quote! { ::ocamlrep::from::field(block, #idx)?, }
        })
    }
    if from_in {
        quote! { #ident(alloc.alloc((#fields))) }
    } else {
        quote! { #ident(::std::boxed::Box::new((#fields))) }
    }
}

fn get_boxed_tuple_len(variant: &VariantInfo<'_>) -> Option<usize> {
    use syn::Fields;
    use syn::GenericArgument;
    use syn::PathArguments;
    use syn::Type;
    use syn::TypePath;
    use syn::TypeReference;

    match &variant.ast().fields {
        Fields::Unnamed(_) => {}
        _ => return None,
    }
    let bi = match variant.bindings() {
        [bi] => bi,
        _ => return None,
    };
    let tuple = match &bi.ast().ty {
        Type::Path(TypePath { path, .. }) => {
            let path_seg = match path.segments.first() {
                Some(s) if s.ident == "Box" => s,
                _ => return None,
            };
            let args = match &path_seg.arguments {
                PathArguments::AngleBracketed(args) => args,
                _ => return None,
            };
            match args.args.first() {
                Some(GenericArgument::Type(Type::Tuple(tuple))) => tuple,
                _ => return None,
            }
        }
        Type::Reference(TypeReference { elem, .. }) => match &**elem {
            Type::Tuple(tuple) => tuple,
            _ => return None,
        },
        _ => return None,
    };
    Some(tuple.elems.len())
}

#[cfg(test)]
mod tests {
    use anyhow::Result;
    use macro_test_util::assert_pat_eq;
    use synstructure::Structure;

    use super::*;

    #[test]
    fn basic_to() -> Result<()> {
        let input = quote! {
                struct A {
                    a: i64,
                    b: i64,
                    #[ocamlrep(skip)]
                    c: f64,
                    d: String,
                }
        };
        assert_pat_eq::<anyhow::Error>(
            Ok(derive_to_ocamlrep(Structure::new(&syn::parse2(input)?))),
            quote! {
                #[allow(non_upper_case_globals)]
                const _DERIVE_ocamlrep_ToOcamlRep_FOR_A: () = {
                    impl ::ocamlrep::ToOcamlRep for A {
                        fn to_ocamlrep<'__ocamlrep_derive_allocator, Alloc: ::ocamlrep::Allocator>(
                            &'__ocamlrep_derive_allocator self,
                            arena: &'__ocamlrep_derive_allocator Alloc,
                        ) -> ::ocamlrep::Value<'__ocamlrep_derive_allocator> {
                            use ::ocamlrep::Allocator;
                            match self {
                                A {
                                    a: ref __binding_0,
                                    b: ref __binding_1,
                                    d: ref __binding_3,
                                    ..
                                } => {
                                    let mut block = arena.block_with_size_and_tag(3usize, 0u8);
                                    arena.set_field(&mut block, 0usize, arena.add(__binding_0));
                                    arena.set_field(&mut block, 1usize, arena.add(__binding_1));
                                    arena.set_field(&mut block, 2usize, arena.add(__binding_3));
                                    block.build()
                                }
                            }
                        }
                    }
                };
            },
        );
        Ok(())
    }

    #[test]
    fn basic_from() -> Result<()> {
        let input = quote! {
              struct A {
                  a: i64,
                  b: i64,
                  #[ocamlrep(skip)]
                  c: f64,
                  d: String,
              }
        };
        assert_pat_eq::<anyhow::Error>(
            Ok(derive_from_ocamlrep(Structure::new(&syn::parse2(input)?))),
            quote! {
                #[allow(non_upper_case_globals)]
                const _DERIVE_ocamlrep_FromOcamlRep_FOR_A: () = {
                    impl ::ocamlrep::FromOcamlRep for A {
                        fn from_ocamlrep(
                            value: ::ocamlrep::Value<'_>
                        ) -> ::std::result::Result<Self, ::ocamlrep::FromError> {
                            use ::ocamlrep::FromOcamlRep;
                            let block = ::ocamlrep::from::expect_tuple(value, 3usize)?;
                            Ok(A {
                                a: ::ocamlrep::from::field(block, 0usize)?,
                                b: ::ocamlrep::from::field(block, 1usize)?,
                                c: ::std::default::Default::default(),
                                d: ::ocamlrep::from::field(block, 2usize)?,
                            })
                        }
                    }
                };
            },
        );
        Ok(())
    }
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

// Assume an opam environment (`eval "$(opam env --switch=default
// --set-switch)"`) then to find the prevailing standard library caml
// headers, `OCAMLLIB=$(ocamlopt.opt -config | grep standard_library:
// | awk '{ print $2 }')`.
fn ocamllib_dir() -> std::path::PathBuf {
    let mut sh = std::process::Command::new("sh");
    sh.args([
        "-c",
        "ocamlopt.opt -config | grep standard_library: | awk '{ print $2 }'",
    ]);
    std::path::Path::new(
        std::str::from_utf8(&sh.output().unwrap().stdout)
            .unwrap()
            .trim(),
    )
    .to_path_buf()
}

fn main() {
    // Tell Cargo that if the given file changes, to rerun this build script.
    println!("cargo:rerun-if-changed=../../ocaml_version.c");
    cc::Build::new()
        .include(ocamllib_dir().as_path().to_str().unwrap())
        .file("ocaml_version.c")
        .compile("ocaml_version");
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

// This file ('deser.rs') was based off c2rust generated code of 'intern.c' at
// revision `15553b77175270d987058b386d737ccb939e8d5a` (i.e. the 4.14.0 tag).

use ocamlrep::Value;

use crate::intext::*;

#[derive(Copy, Clone)]
#[repr(C)]
pub struct MarshalHeader {
    pub magic: u32,
    pub header_len: i32,
    pub data_len: usize,
    pub num_objects: usize,
    pub whsize: usize,
}

struct InternItem<'a> {
    pub dest: *mut Value<'a>,
    pub arg: usize,
    pub op: InternItemStackOp,
}

enum InternItemStackOp {
    ReadItems = 0,
}

struct State<'s, 'a, A> {
    /// Slice holding input data.
    intern_src: &'s [u8],

    /// The allocator of OCaml objects, e.g. `ocamlrep::Arena` or
    /// `ocamlrep_ocamlpool::Pool`.
    alloc: &'a A,

    /// Count how many objects seen so far.
    obj_counter: usize,

    /// Objects already seen.
    intern_obj_table: Vec<Value<'a>>,

    /// The "recursion stack" used in `intern_rec`.
    stack: Vec<InternItem<'a>>,
}

impl<'s, 'a, A: ocamlrep::Allocator> State<'s, 'a, A> {
    const INTERN_STACK_INIT_SIZE: usize = 256;

    fn new(alloc: &'a A, intern_src: &'s [u8]) -> Self {
        Self {
            intern_src,
            alloc,
            obj_counter: 0,
            intern_obj_table: Vec::new(),
            stack: Vec::with_capacity(Self::INTERN_STACK_INIT_SIZE),
        }
    }

    #[inline]
    fn read8u(&mut self) -> u8 {
        let size = std::mem::size_of::<u8>();
        let res = u8::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[size..];
        res
    }

    #[inline]
    fn read8s(&mut self) -> i8 {
        let size = std::mem::size_of::<i8>();
        let res = i8::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[size..];
        res
    }

    #[inline]
    fn read16u(&mut self) -> u16 {
        let size = std::mem::size_of::<u16>();
        let res = u16::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[size..];
        res
    }

    #[inline]
    fn read16s(&mut self) -> i16 {
        let size = std::mem::size_of::<i16>();
        let res = i16::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[size..];
        res
    }

    #[inline]
    fn read32u(&mut self) -> u32 {
        let size = std::mem::size_of::<u32>();
        let res = u32::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[size..];
        res
    }

    #[inline]
    fn read32s(&mut self) -> i32 {
        let size = std::mem::size_of::<i32>();
        let res = i32::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[size..];
        res
    }

    #[inline]
    fn read64u(&mut self) -> u64 {
        let size = std::mem::size_of::<u64>();
        let res = u64::from_be_bytes(self.intern_src[..size].try_into().unwrap());
        self.intern_src = &self.intern_src[8..];
        res
    }

    fn readfloat(&mut self, dst: &mut f64, code: u8) {
        if std::mem::size_of::<f64>() != 8 {
            panic!("input_value: non-standard floats");
        }
        let src: [u8; 8] = self.intern_src[..8].try_into().unwrap();
        self.intern_src = &self.intern_src[8..];
        *dst = match code {
            CODE_DOUBLE_BIG => f64::from_be_bytes(src),
            CODE_DOUBLE_LITTLE => f64::from_le_bytes(src),
            _ => unreachable!(),
        }
    }

    fn readfloats(&mut self, dest: &mut [f64], code: u8) {
        if std::mem::size_of::<f64>() != 8 {
            panic!("input_value: non-standard floats");
        }
        let count = dest.len() * 8; // number of bytes
        let bytes = &self.intern_src[..count];
        self.intern_src = &self.intern_src[count..];
        for (i, bytes) in bytes.chunks_exact(8).enumerate() {
            let src: [u8; 8] = bytes.try_into().unwrap();
            dest[i] = match code {
                CODE_DOUBLE_ARRAY8_BIG | CODE_DOUBLE_ARRAY32_BIG => f64::from_be_bytes(src),
                CODE_DOUBLE_ARRAY8_LITTLE | CODE_DOUBLE_ARRAY32_LITTLE => f64::from_le_bytes(src),
                _ => unreachable!(),
            };
        }
    }

    unsafe fn intern_rec(&mut self, mut dest: *mut Value<'a>) {
        const READ_BLOCK_LABEL: u64 = 16649699497103515194;
        const READ_STRING_LABEL: u64 = 11970676656440271524;
        const READ_SHARED_LABEL: u64 = 8656139126282042408;
        const READ_DOUBLE_ARRAY_LABEL: u64 = 8966088013221564425;
        const NOTHING_TO_DO_LABEL: u64 = 8288085890650723895;

        let mut current_block: u64;
        let mut header: usize;
        let mut code: u8;

        let mut tag: u8 = 0;
        let mut size: usize = 0;
        let mut len: usize = 0;
        let mut v: Value<'a> = Value::from_bits(0);
        let mut ofs: usize = 0;

        // Initially let's try to read the first object from the stream
        self.stack.push(InternItem {
            op: InternItemStackOp::ReadItems,
            dest,
            arg: 1,
        });

        // The un-marshaler loop, the recursion is unrolled
        while let Some(top) = self.stack.last_mut() {
            // Interpret next item on the stack
            dest = top.dest;

            match top.op {
                InternItemStackOp::ReadItems => {
                    // Pop item
                    top.dest = top.dest.offset(1);
                    top.arg -= 1;
                    if top.arg == 0 {
                        self.stack.pop();
                    }
                    // Read a value and set v to this value
                    code = self.read8u();
                    if code >= PREFIX_SMALL_INT {
                        if code >= PREFIX_SMALL_BLOCK {
                            // Small block
                            tag = code & 0xf;
                            size = (code >> 4 & 0x7) as usize;
                            current_block = READ_BLOCK_LABEL;
                        } else {
                            // Small integer
                            v = Value::int((code & 0x3F) as isize);
                            current_block = NOTHING_TO_DO_LABEL;
                        }
                    } else {
                        if code >= PREFIX_SMALL_STRING {
                            // Small string
                            len = (code & 0x1f) as usize;
                            current_block = READ_STRING_LABEL;
                        } else {
                            match code {
                                CODE_INT8 => {
                                    v = Value::from_bits(((self.read8s() as usize) << 1) + 1);
                                    current_block = NOTHING_TO_DO_LABEL;
                                }
                                CODE_INT16 => {
                                    v = Value::from_bits(((self.read16s() as usize) << 1) + 1);
                                    current_block = NOTHING_TO_DO_LABEL;
                                }
                                CODE_INT32 => {
                                    v = Value::from_bits(((self.read32s() as usize) << 1) + 1);
                                    current_block = NOTHING_TO_DO_LABEL;
                                }
                                CODE_INT64 => {
                                    v = Value::from_bits(((self.read64u() as usize) << 1) + 1);
                                    current_block = NOTHING_TO_DO_LABEL;
                                }
                                CODE_SHARED8 => {
                                    ofs = self.read8u() as usize;
                                    current_block = READ_SHARED_LABEL;
                                }
                                CODE_SHARED16 => {
                                    ofs = self.read16u() as usize;
                                    current_block = READ_SHARED_LABEL;
                                }
                                CODE_SHARED32 => {
                                    ofs = self.read32u() as usize;
                                    current_block = READ_SHARED_LABEL;
                                }
                                CODE_SHARED64 => {
                                    ofs = self.read64u() as usize;
                                    current_block = READ_SHARED_LABEL;
                                }
                                CODE_BLOCK32 => {
                                    header = self.read32u() as usize;
                                    tag = (header & 0xff) as u8;
                                    size = header >> 10;
                                    current_block = READ_BLOCK_LABEL;
                                }
                                CODE_BLOCK64 => {
                                    header = self.read64u() as usize;
                                    tag = (header & 0xff) as u8;
                                    size = header >> 10;
                                    current_block = READ_BLOCK_LABEL;
                                }
                                CODE_STRING8 => {
                                    len = self.read8u() as usize;
                                    current_block = READ_STRING_LABEL;
                                }
                                CODE_STRING32 => {
                                    len = self.read32u() as usize;
                                    current_block = READ_STRING_LABEL;
                                }
                                CODE_STRING64 => {
                                    len = self.read64u() as usize;
                                    current_block = READ_STRING_LABEL;
                                }
                                CODE_DOUBLE_LITTLE | CODE_DOUBLE_BIG => {
                                    let mut builder = self.alloc.block_with_size_and_tag(
                                        ocamlrep::DOUBLE_WOSIZE,
                                        ocamlrep::DOUBLE_TAG,
                                    );
                                    self.readfloat(
                                        &mut *(self.alloc.block_ptr_mut(&mut builder) as *mut f64),
                                        code,
                                    );
                                    v = Value::from_bits(builder.build().to_bits());
                                    self.obj_counter += 1;
                                    self.intern_obj_table.push(v);
                                    current_block = NOTHING_TO_DO_LABEL;
                                }
                                CODE_DOUBLE_ARRAY8_LITTLE | CODE_DOUBLE_ARRAY8_BIG => {
                                    len = self.read8u() as usize;
                                    current_block = READ_DOUBLE_ARRAY_LABEL;
                                }
                                CODE_DOUBLE_ARRAY32_LITTLE | CODE_DOUBLE_ARRAY32_BIG => {
                                    len = self.read32u() as usize;
                                    current_block = READ_DOUBLE_ARRAY_LABEL;
                                }
                                CODE_DOUBLE_ARRAY64_LITTLE | CODE_DOUBLE_ARRAY64_BIG => {
                                    len = self.read64u() as usize;
                                    current_block = READ_DOUBLE_ARRAY_LABEL;
                                }
                                CODE_CODEPOINTER | CODE_INFIXPOINTER | CODE_CUSTOM
                                | CODE_CUSTOM_LEN | CODE_CUSTOM_FIXED => {
                                    unimplemented!()
                                }
                                _ => {
                                    panic!("input_value: ill-formed message");
                                }
                            }
                            match current_block {
                                NOTHING_TO_DO_LABEL | READ_BLOCK_LABEL | READ_STRING_LABEL => {}
                                _ => {
                                    match current_block {
                                        READ_SHARED_LABEL => {
                                            v = self.intern_obj_table[self.obj_counter - ofs];
                                        }
                                        _ /* READ_DOUBLE_ARRAY_LABEL */ => {
                                            size = len * ocamlrep::DOUBLE_WOSIZE;
                                            let mut builder = self.alloc.block_with_size_and_tag(
                                                size,
                                                ocamlrep::DOUBLE_ARRAY_TAG,
                                            );
                                            self.readfloats(
                                                std::slice::from_raw_parts_mut(self.alloc.block_ptr_mut(&mut builder) as *mut f64, len),
                                                code,
                                            );
                                            v = Value::from_bits(builder.build().to_bits());
                                            self.obj_counter += 1;
                                            self.intern_obj_table.push(v);
                                        }
                                    }
                                    current_block = NOTHING_TO_DO_LABEL;
                                }
                            }
                        }
                        match current_block {
                            NOTHING_TO_DO_LABEL| READ_BLOCK_LABEL => {}
                            _ /* READ_STRING_LABEL */ => {
                                size = (len + std::mem::size_of::<Value<'_>>()) / std::mem::size_of::<Value<'_>>();
                                v = Value::from_bits(ocamlrep::bytes_to_ocamlrep(&self.intern_src[..len], self.alloc).to_bits());
                                self.intern_src = &self.intern_src[len..];
                                self.obj_counter += 1;
                                self.intern_obj_table.push(v);
                                current_block = NOTHING_TO_DO_LABEL;
                            }
                        }
                    }
                    match current_block {
                        READ_BLOCK_LABEL => {
                            if size == 0 {
                                panic!("input_value: atoms are not supported");
                            } else {
                                let mut builder = self.alloc.block_with_size_and_tag(size, tag);
                                if tag == ocamlrep::OBJECT_TAG {
                                    panic!("input_value: objects not supported");
                                } else {
                                    // If it's not an object then read the
                                    // contents of the block
                                    self.stack.push(InternItem {
                                        op: InternItemStackOp::ReadItems,
                                        dest: self.alloc.block_ptr_mut(&mut builder)
                                            as *mut Value<'a>,
                                        arg: size,
                                    });
                                }
                                v = Value::from_bits(builder.build().to_bits());
                                self.obj_counter += 1;
                                self.intern_obj_table.push(v);
                            }
                        }
                        _ => {}
                    }
                    *dest = v
                }
            }
        }
    }

    unsafe fn parse_header(&mut self, h: *mut MarshalHeader) {
        (*h).magic = self.read32u();
        match (*h).magic {
            MAGIC_NUMBER_SMALL => {
                (*h).header_len = 20;
                (*h).data_len = self.read32u() as usize;
                (*h).num_objects = self.read32u() as usize;
                self.read32u();
                (*h).whsize = self.read32u() as usize
            }
            MAGIC_NUMBER_BIG => {
                (*h).header_len = 32;
                self.read32u();
                (*h).data_len = self.read64u() as usize;
                (*h).num_objects = self.read64u() as usize;
                (*h).whsize = self.read64u() as usize;
            }
            _ => panic!("input_value: bad object"),
        };
    }

    unsafe fn input_val_from_string(&mut self, str: &'s [u8]) -> usize {
        let mut obj = Value::int(0).to_bits();
        let mut h = MarshalHeader {
            magic: 0,
            header_len: 0,
            data_len: 0,
            num_objects: 0,
            whsize: 0,
        };
        self.parse_header(&mut h);
        if h.header_len as usize + h.data_len > str.len() {
            panic!("input_value: bad length");
        }
        self.intern_src = &str[(h.header_len as usize)..];
        self.intern_rec(&mut obj as *mut usize as *mut Value<'a>);

        obj
    }
}

pub unsafe fn input_value<'s, 'a, A: ocamlrep::Allocator>(
    str: &'s [u8],
    alloc: &'a A,
) -> ocamlrep::Value<'a> {
    let mut state = State::new(alloc, str);
    ocamlrep::Value::from_bits(state.input_val_from_string(str))
}


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.
#![allow(dead_code)] //for now

pub(crate) const MAGIC_NUMBER_SMALL: u32 = 0x8495A6BE; // 10000100100101011010011010111110
pub(crate) const MAGIC_NUMBER_BIG: u32 = 0x8495A6BF; // 10000100100101011010011010111111

///   Header format for the "small" model: 20 bytes
///       0   "small" magic number
///       4   length of marshaled data, in bytes
///       8   number of shared blocks
///      12   size in words when read on a 32-bit platform
///      16   size in words when read on a 64-bit platform
///   The 4 numbers are 32 bits each, in big endian.
///
///   Header format for the "big" model: 32 bytes
///       0   "big" magic number
///       4   four reserved bytes, currently set to 0
///       8   length of marshaled data, in bytes
///      16   number of shared blocks
///      24   size in words when read on a 64-bit platform
///   The 3 numbers are 64 bits each, in big endian.

// ---
// c.f. runtime/caml/config.h

#[cfg(target_arch = "arm")]
// Careful. This might not be quite right. See
// https://github.com/ocaml/ocaml/issues/4224.
pub(crate) const ARCH_FLOAT_ENDIANNESS: u32 = 0x45670123;

#[cfg(not(target_arch = "arm"))]
#[cfg(target_endian = "big")]
pub(crate) const ARCH_FLOAT_ENDIANNESS: u32 = 0x76543210;

#[cfg(not(target_arch = "arm"))]
#[cfg(target_endian = "little")]
pub(crate) const ARCH_FLOAT_ENDIANNESS: u32 = 0x01234567;

// ---

// Codes for the compact format

pub(crate) const PREFIX_SMALL_BLOCK: u8 = 0x80; // 10000000
pub(crate) const PREFIX_SMALL_INT: u8 = 0x40; // 01000000
pub(crate) const PREFIX_SMALL_STRING: u8 = 0x20; // 00100000
pub(crate) const CODE_INT8: u8 = 0x0; // 00000000
pub(crate) const CODE_INT16: u8 = 0x1; // 00000001
pub(crate) const CODE_INT32: u8 = 0x2; // 00000010
pub(crate) const CODE_INT64: u8 = 0x3; // 00000011
pub(crate) const CODE_SHARED8: u8 = 0x4; // 00000100
pub(crate) const CODE_SHARED16: u8 = 0x5; // 00000101
pub(crate) const CODE_SHARED32: u8 = 0x6; // 00000110
pub(crate) const CODE_SHARED64: u8 = 0x14; // 00010100
pub(crate) const CODE_BLOCK32: u8 = 0x8; // 00001000
pub(crate) const CODE_BLOCK64: u8 = 0x13; // 00010011
pub(crate) const CODE_STRING8: u8 = 0x9; // 00001001
pub(crate) const CODE_STRING32: u8 = 0xA; // 00001010
pub(crate) const CODE_STRING64: u8 = 0x15; // 00010101
pub(crate) const CODE_DOUBLE_BIG: u8 = 0xB; // 00001011
pub(crate) const CODE_DOUBLE_LITTLE: u8 = 0xC; // 00001100
pub(crate) const CODE_DOUBLE_ARRAY8_BIG: u8 = 0xD; // 00001101
pub(crate) const CODE_DOUBLE_ARRAY8_LITTLE: u8 = 0xE; // 00001110
pub(crate) const CODE_DOUBLE_ARRAY32_BIG: u8 = 0xF; // 00001111
pub(crate) const CODE_DOUBLE_ARRAY32_LITTLE: u8 = 0x7; // 00000111
pub(crate) const CODE_DOUBLE_ARRAY64_BIG: u8 = 0x16; // 00010110
pub(crate) const CODE_DOUBLE_ARRAY64_LITTLE: u8 = 0x17; // 00010111
pub(crate) const CODE_CODEPOINTER: u8 = 0x10; // 00010000
pub(crate) const CODE_INFIXPOINTER: u8 = 0x11; // 00010001
pub(crate) const CODE_CUSTOM: u8 = 0x12; // 00010010 (deprecated)
pub(crate) const CODE_CUSTOM_LEN: u8 = 0x18; // 00011000
pub(crate) const CODE_CUSTOM_FIXED: u8 = 0x19; // 00011001

macro_rules! cond_arch_float_endian {
    ($if_:ident, $else_:ident) => {
        if ARCH_FLOAT_ENDIANNESS == 0x76543210 {
            $if_
        } else {
            $else_
        }
    };
}
pub(crate) const CODE_DOUBLE_NATIVE: u8 =
    cond_arch_float_endian!(CODE_DOUBLE_BIG, CODE_DOUBLE_LITTLE);
pub(crate) const CODE_DOUBLE_ARRAY8_NATIVE: u8 =
    cond_arch_float_endian!(CODE_DOUBLE_ARRAY8_BIG, CODE_DOUBLE_ARRAY8_LITTLE);
pub(crate) const CODE_DOUBLE_ARRAY32_NATIVE: u8 =
    cond_arch_float_endian!(CODE_DOUBLE_ARRAY32_BIG, CODE_DOUBLE_ARRAY32_LITTLE);
pub(crate) const CODE_DOUBLE_ARRAY64_NATIVE: u8 =
    cond_arch_float_endian!(CODE_DOUBLE_ARRAY64_BIG, CODE_DOUBLE_ARRAY64_LITTLE);

///   Size-ing data structures for extern.  Chosen so that
///   sizeof(struct trail_block) and sizeof(struct output_block)
///   are slightly below 8Kb.
pub(crate) const ENTRIES_PER_TRAIL_BLOCK: i16 = 1025;
pub(crate) const SIZE_EXTERN_OUTPUT_BLOCK: usize = 8100;


// Copyright (c) Meta Platforms, Inc. and affiliates.
//
// This source code is licensed under the MIT license found in the
// LICENSE file in the root directory of this source tree.

#![feature(new_uninit)]

mod deser; // deserialize; c.f 'runtime/intern.c'
mod intext; // c.f. 'runtime/caml/intext.h'
mod ser; // serialize; c.f. 'runtime/extern.c'

pub use deser::input_value;
pub use ser::output_value;
pub use ser::ExternFlags;