// 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.

//! FFI types for representing pointers-to-OCaml-managed-data in Rust
//! (`UnsafeOcamlPtr`) and pointers-to-Rust-managed-data in OCaml (`NakedPtr`).

use std::fmt;
use std::num::NonZeroUsize;

use crate::Allocator;
use crate::FromError;
use crate::FromOcamlRep;
use crate::ToOcamlRep;
use crate::Value;

/// Unsafe pointer to an OCaml value which is (possibly) managed by the garbage
/// collector.
///
/// Take care that the value stays rooted or the garbage collector does not run
/// while an UnsafeOcamlPtr wrapper for it exists.
///
/// While this can be used with an ocamlrep::Arena via to_ocamlrep, caution is
/// required--the pointed-to value will *not* be cloned into the Arena, so a
/// data structure containing UnsafeOcamlPtrs which is allocated into an Arena
/// may contain pointers into the OCaml GC-ed heap.
#[repr(transparent)]
#[derive(Clone, Copy, Hash, PartialEq, Eq)]
pub struct UnsafeOcamlPtr(NonZeroUsize);

impl UnsafeOcamlPtr {
    pub unsafe fn new(ptr: usize) -> Self {
        Self(NonZeroUsize::new(ptr).unwrap())
    }

    pub fn as_usize(self) -> usize {
        self.0.get()
    }

    #[inline(always)]
    pub const fn is_int(self) -> bool {
        // SAFETY: `Value::is_int` only checks the low bit, so it's safe
        // to interpret `self.0` as a value (we don't attempt to dereference it)
        unsafe { self.as_value().is_int() }
    }

    #[inline(always)]
    pub const fn is_block(self) -> bool {
        // SAFETY: `Value::is_block` only checks the low bit, so it's safe
        // to interpret `self.0` as a value (we don't attempt to dereference it)
        unsafe { self.as_value().is_block() }
    }

    /// Interpret this pointer as an OCaml value which is valid for lifetime 'a.
    /// The OCaml garbage collector must not run during this lifetime (even if
    /// the value is rooted).
    #[inline(always)]
    pub const unsafe fn as_value<'a>(self) -> Value<'a> {
        Value::from_bits(self.0.get())
    }
}

impl fmt::Debug for UnsafeOcamlPtr {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        write!(f, "0x{:x}", self.0)
    }
}

impl ToOcamlRep for UnsafeOcamlPtr {
    fn to_ocamlrep<'a, A: Allocator>(&'a self, _alloc: &'a A) -> Value<'a> {
        unsafe { Value::from_bits(self.0.get()) }
    }
}

impl FromOcamlRep for UnsafeOcamlPtr {
    fn from_ocamlrep(value: Value<'_>) -> Result<Self, FromError> {
        if value.is_int() {
            return Err(FromError::ExpectedBlock(value.as_int().unwrap()));
        }
        Ok(unsafe { Self::new(value.to_bits()) })
    }
}

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

/// Any kind of foreign pointer (i.e., a pointer to any data at all--it need not
/// look like a valid OCaml value).
///
/// On the OCaml side, these are represented as opaque types, e.g. `type addr;`.
///
/// The pointer must not be within a memory page currently in use by the OCaml
/// runtime for the garbage-collected heap (i.e., it must in fact be a foreign
/// pointer).
///
/// Can only be used when linking against a binary built with an OCaml compiler
/// which was **not** configured with the `-no-naked-pointers` option (which
/// forbids naked pointers, requiring foreign pointers to be wrapped in a block
/// tagged with `Abstract_tag` instead).
#[repr(transparent)]
#[derive(Clone, Copy, Hash, PartialEq, Eq)]
pub struct NakedPtr<T>(*const T);

impl<T> NakedPtr<T> {
    pub fn new(ptr: *const T) -> Self {
        Self(ptr)
    }

    pub fn as_ptr(self) -> *const T {
        self.0
    }
}

impl<T> fmt::Debug for NakedPtr<T> {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        write!(f, "{:p}", self.0)
    }
}

impl<T> ToOcamlRep for NakedPtr<T> {
    fn to_ocamlrep<'a, A: Allocator>(&'a self, _alloc: &'a A) -> Value<'a> {
        unsafe { Value::from_bits(self.0 as usize) }
    }
}

impl<T> FromOcamlRep for NakedPtr<T> {
    fn from_ocamlrep(value: Value<'_>) -> Result<Self, FromError> {
        if value.is_int() {
            return Err(FromError::ExpectedBlock(value.as_int().unwrap()));
        }
        Ok(Self::new(value.to_bits() as *const T))
    }
}


// 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.

//! Provides `RcOc`, a single-threaded reference-counting pointer. `RcOc` stands
//! for "reference counted with Ocaml-value cache".

use std::cell::Cell;
use std::cmp::Ordering;
use std::fmt;
use std::hash::Hash;
use std::hash::Hasher;
use std::ops::Deref;
use std::rc::Rc;

use bumpalo::Bump;
use serde::Deserialize;
use serde::Deserializer;
use serde::Serialize;
use serde::Serializer;

use crate::Allocator;
use crate::FromError;
use crate::FromOcamlRep;
use crate::ToOcamlRep;
use crate::Value;

const UNIT: usize = crate::value::isize_to_ocaml_int(0);
const INVALID_GENERATION: usize = usize::max_value();

struct OcamlValueCache<T> {
    forward_pointer: Cell<usize>,
    generation: Cell<usize>,
    value: T,
}

impl<T> OcamlValueCache<T> {
    #[inline(always)]
    pub fn new(value: T) -> Self {
        OcamlValueCache {
            forward_pointer: Cell::new(UNIT),
            generation: Cell::new(INVALID_GENERATION),
            value,
        }
    }

    #[inline(always)]
    pub fn get_in_generation(&self, generation: usize) -> Option<usize> {
        if generation == self.generation.get() {
            Some(self.forward_pointer.get())
        } else {
            None
        }
    }

    #[inline(always)]
    pub fn set(&self, value: usize, generation: usize) {
        assert!(generation != INVALID_GENERATION);
        self.forward_pointer.set(value);
        self.generation.set(generation);
    }

    #[inline(always)]
    fn clear(&self) {
        self.forward_pointer.set(UNIT);
        self.generation.set(INVALID_GENERATION);
    }
}

impl<T: Clone> Clone for OcamlValueCache<T> {
    #[inline(always)]
    fn clone(&self) -> Self {
        OcamlValueCache::new(self.value.clone())
    }
}

#[allow(clippy::partialeq_ne_impl)]
impl<T: PartialEq> PartialEq for OcamlValueCache<T> {
    #[inline(always)]
    fn eq(&self, other: &OcamlValueCache<T>) -> bool {
        self.value.eq(&other.value)
    }

    #[inline(always)]
    fn ne(&self, other: &OcamlValueCache<T>) -> bool {
        self.value.ne(&other.value)
    }
}

impl<T: Eq> Eq for OcamlValueCache<T> {}

/// A single-threaded reference-counting pointer type, which, as a performance
/// optimization, can cache the result of converting the pointed-to value to an
/// OCaml value. `RcOc` stands for "reference counted with Ocaml-value cache".
///
/// Internally uses `std::rc::Rc`, so restrictions on `Rc` also apply to `RcOc`.
/// It is encouraged to follow `Rc` conventions (such as preferring the use of
/// `RcOc::clone(x)` rather than `x.clone()`) when using `RcOc`.
pub struct RcOc<T> {
    ptr: Rc<OcamlValueCache<T>>,
}

impl<T> RcOc<T> {
    #[inline(always)]
    pub fn new(value: T) -> Self {
        Self {
            ptr: Rc::new(OcamlValueCache::new(value)),
        }
    }

    #[inline(always)]
    pub fn get_cached_value_in_generation(&self, generation: usize) -> Option<usize> {
        (*self.ptr).get_in_generation(generation)
    }

    #[inline(always)]
    pub fn set_cached_value(&self, value: usize, generation: usize) {
        (*self.ptr).set(value, generation)
    }

    #[inline(always)]
    pub fn clear_cache(&self) {
        (*self.ptr).clear();
    }

    #[inline(always)]
    pub fn get_mut(this: &mut Self) -> Option<&mut T> {
        Rc::get_mut(&mut this.ptr).map(|cache| {
            // We are about to give permission to mutate the value, so
            // invalidate the cache.
            cache.clear();
            &mut cache.value
        })
    }

    #[inline(always)]
    pub fn ptr_eq(this: &Self, other: &Self) -> bool {
        Rc::ptr_eq(&this.ptr, &other.ptr)
    }

    /// Returns the inner value, if the `Rc` has exactly one strong reference.
    ///
    /// Otherwise, an `Err` is returned with the same `Rc` that was passed in.
    ///
    /// This will succeed even if there are outstanding weak references.
    #[inline(always)]
    pub fn try_unwrap(this: Self) -> Result<T, Self> {
        match Rc::try_unwrap(this.ptr) {
            Ok(cache) => Ok(cache.value),
            Err(ptr) => Err(Self { ptr }),
        }
    }
}

impl<T: Clone> RcOc<T> {
    #[inline(always)]
    pub fn make_mut(this: &mut Self) -> &mut T {
        // If the refcount is 1, Rc::make_mut will give permission to mutate the
        // value (rather than cloning it), so invalidate the cache.
        if Rc::strong_count(&this.ptr) == 1 {
            this.clear_cache();
        }
        &mut Rc::make_mut(&mut this.ptr).value
    }
}

impl<T> AsRef<T> for RcOc<T> {
    #[inline(always)]
    fn as_ref(&self) -> &T {
        &self.ptr.as_ref().value
    }
}

impl<T> Clone for RcOc<T> {
    #[inline(always)]
    fn clone(&self) -> Self {
        Self {
            ptr: Rc::clone(&self.ptr),
        }
    }
}

impl<T> Deref for RcOc<T> {
    type Target = T;

    #[inline(always)]
    fn deref(&self) -> &T {
        &self.ptr.deref().value
    }
}

#[allow(clippy::partialeq_ne_impl)]
impl<T: PartialEq> PartialEq for RcOc<T> {
    #[inline(always)]
    fn eq(&self, other: &RcOc<T>) -> bool {
        self.ptr.eq(&other.ptr)
    }

    #[inline(always)]
    fn ne(&self, other: &RcOc<T>) -> bool {
        self.ptr.ne(&other.ptr)
    }
}

impl<T: Eq> Eq for RcOc<T> {}

impl<T: PartialOrd> PartialOrd for RcOc<T> {
    #[inline(always)]
    fn partial_cmp(&self, other: &RcOc<T>) -> Option<Ordering> {
        (**self).partial_cmp(&**other)
    }

    #[inline(always)]
    fn lt(&self, other: &RcOc<T>) -> bool {
        **self < **other
    }

    #[inline(always)]
    fn le(&self, other: &RcOc<T>) -> bool {
        **self <= **other
    }

    #[inline(always)]
    fn gt(&self, other: &RcOc<T>) -> bool {
        **self > **other
    }

    #[inline(always)]
    fn ge(&self, other: &RcOc<T>) -> bool {
        **self >= **other
    }
}

impl<T: Ord> Ord for RcOc<T> {
    #[inline]
    fn cmp(&self, other: &RcOc<T>) -> Ordering {
        (**self).cmp(&**other)
    }
}

impl<T: Hash> Hash for RcOc<T> {
    fn hash<H: Hasher>(&self, state: &mut H) {
        (**self).hash(state);
    }
}

impl<T: fmt::Display> fmt::Display for RcOc<T> {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        fmt::Display::fmt(&**self, f)
    }
}

impl<T: fmt::Debug> fmt::Debug for RcOc<T> {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        fmt::Debug::fmt(&**self, f)
    }
}

impl<T> fmt::Pointer for RcOc<T> {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        fmt::Pointer::fmt(&(&**self as *const T), f)
    }
}

impl<T: ToOcamlRep> ToOcamlRep for RcOc<T> {
    fn to_ocamlrep<'a, A: Allocator>(&'a self, alloc: &'a A) -> Value<'a> {
        let generation = alloc.generation();
        match self.get_cached_value_in_generation(generation) {
            Some(value) => unsafe { Value::from_bits(value) },
            None => {
                let value = alloc.add(self.as_ref());
                self.set_cached_value(value.to_bits(), generation);
                value
            }
        }
    }
}

impl<T: FromOcamlRep> FromOcamlRep for RcOc<T> {
    fn from_ocamlrep(value: Value<'_>) -> Result<Self, FromError> {
        // NB: We don't get any sharing this way.
        Ok(RcOc::new(T::from_ocamlrep(value)?))
    }
}

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

impl<T: Serialize> Serialize for RcOc<T> {
    #[inline]
    fn serialize<S>(&self, serializer: S) -> Result<S::Ok, S::Error>
    where
        S: Serializer,
    {
        (**self).serialize(serializer)
    }
}

impl<'de, T: Deserialize<'de>> Deserialize<'de> for RcOc<T> {
    fn deserialize<D>(deserializer: D) -> Result<Self, D::Error>
    where
        D: Deserializer<'de>,
    {
        // NB: We don't get any sharing this way.
        // FWIW, looks like serde doesn't preserve sharing for Rc either.
        // https://github.com/serde-rs/serde/blob/a00aee14950baca7de2e334b895e203b013712da/serde/src/de/impls.rs#L1806-L1808
        Deserialize::deserialize(deserializer).map(RcOc::new)
    }
}


// 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::borrow::Cow;
use std::collections::HashMap;
use std::fmt;
use std::fmt::Debug;
use std::marker::PhantomData;

use crate::block;
use crate::block::Block;
use crate::block::Header;
use crate::Allocator;

#[inline(always)]
pub const fn is_ocaml_int(value: usize) -> bool {
    value & 1 == 1
}

#[inline(always)]
pub const fn isize_to_ocaml_int(value: isize) -> usize {
    ((value as usize) << 1) | 1
}

#[inline(always)]
pub const fn ocaml_int_to_isize(value: usize) -> isize {
    (value as isize) >> 1
}

/// A value, as represented by OCaml. Valid, immutable, and immovable for
/// lifetime `'a`.
///
/// Either a tagged integer value or a pointer to a [`Block`](struct.Block.html)
/// containing fields or binary data.
#[repr(transparent)]
#[derive(Clone, Copy, Hash, PartialEq, Eq)]
pub struct Value<'a>(pub(crate) usize, PhantomData<&'a ()>);

impl<'a> Value<'a> {
    #[inline(always)]
    pub const fn is_int(self) -> bool {
        is_ocaml_int(self.0)
    }

    #[inline(always)]
    pub const fn is_block(self) -> bool {
        !self.is_int()
    }

    #[inline(always)]
    pub const fn int(value: isize) -> Value<'static> {
        Value(isize_to_ocaml_int(value), PhantomData)
    }

    #[inline(always)]
    pub fn as_int(self) -> Option<isize> {
        if self.is_int() {
            Some(ocaml_int_to_isize(self.0))
        } else {
            None
        }
    }

    #[inline(always)]
    pub fn as_block(self) -> Option<Block<'a>> {
        if self.is_int() {
            return None;
        }
        let block = unsafe {
            let ptr = self.0 as *const Value<'_>;
            let header = ptr.offset(-1);
            let size = Header::from_bits((*header).to_bits()).size() + 1;
            std::slice::from_raw_parts(header, size)
        };
        Some(Block(block))
    }

    #[inline(always)]
    pub fn as_float(self) -> Option<f64> {
        let block = self.as_block()?;
        if block.tag() != block::DOUBLE_TAG {
            return None;
        }
        Some(f64::from_bits(block[0].0 as u64))
    }

    #[inline(always)]
    pub fn as_double_array(self) -> Option<&'a [f64]> {
        let block = self.as_block()?;
        if block.tag() != block::DOUBLE_ARRAY_TAG {
            return None;
        }
        Some(unsafe {
            std::slice::from_raw_parts(block.0.as_ptr().add(1) as *const f64, block.size())
        })
    }

    #[inline(always)]
    pub fn as_byte_string(self) -> Option<&'a [u8]> {
        let block = self.as_block()?;
        if block.tag() != block::STRING_TAG {
            return None;
        }
        let slice = unsafe {
            let size = block.size() * std::mem::size_of::<Value<'_>>();
            let ptr = self.0 as *mut u8;
            let last_byte = ptr.offset(size as isize - 1);
            let padding = *last_byte;
            let size = size - padding as usize - 1;
            std::slice::from_raw_parts(ptr, size)
        };
        Some(slice)
    }

    #[inline(always)]
    pub fn as_str(self) -> Option<Cow<'a, str>> {
        let slice = self.as_byte_string()?;
        Some(String::from_utf8_lossy(slice))
    }

    #[inline(always)]
    pub fn field(self, index: usize) -> Option<Value<'a>> {
        self.field_ref(index).copied()
    }

    #[inline(always)]
    pub fn field_ref(self, index: usize) -> Option<&'a Value<'a>> {
        self.as_block()?.as_values()?.get(index)
    }

    /// Given a pointer to the first field of a [`Block`](struct.Block.html),
    /// create a pointer `Value` referencing that `Block`.
    ///
    /// # Safety
    ///
    /// This method is unsafe because it requires that the pointed-to Value is
    /// the first field of a block, which must be preceded by a valid Header
    /// correctly describing the block's size and tag (i.e., value.offset(-1)
    /// should point to that Header). To be used only with pointers returned by
    /// Arena allocation methods (e.g.,
    /// [`Allocator::block_with_size_and_tag`](trait.Allocator.html#tymethod.block_with_size_and_tag).
    #[inline(always)]
    pub unsafe fn from_ptr(value: *const Value<'a>) -> Value<'a> {
        Value(value as usize, PhantomData)
    }

    /// # Safety
    ///
    /// The lifetime 'a returned is arbitrarily chosen, and does not necessarily
    /// reflect the actual lifetime of the data. If the given value is a
    /// pointer, it is up to the caller to ensure that for the duration of this
    /// lifetime, the block this pointer points to, and every value reachable
    /// from it, does not get written to.
    #[inline(always)]
    pub const unsafe fn from_bits(value: usize) -> Value<'a> {
        Value(value, PhantomData)
    }

    /// Convert this value to a usize, which can be handed to the OCaml runtime
    /// to be used as an OCaml value. Take care that the returned value does
    /// not outlive the arena.
    #[inline(always)]
    pub const fn to_bits(self) -> usize {
        self.0
    }

    /// Helper for `Value::clone_with_allocator`.
    pub(crate) fn clone_with<'b>(
        self,
        alloc: &'b impl Allocator,
        seen: &mut HashMap<usize, Value<'b>>,
    ) -> Value<'b> {
        match self.as_block() {
            None => Value(self.0, PhantomData),
            Some(block) => {
                if let Some(&copied_value) = seen.get(&self.0) {
                    return copied_value;
                }
                let copied_value = block.clone_with(alloc, seen);
                seen.insert(self.0, copied_value);
                copied_value
            }
        }
    }

    /// Recursively clone this `Value` using the given `Allocator`. Structural
    /// sharing is preserved (i.e., values which are physically equal before the
    /// clone will be physically equal after the clone).
    pub fn clone_with_allocator(self, alloc: &impl Allocator) -> Value<'_> {
        self.clone_with(alloc, &mut HashMap::new())
    }
}

impl Debug for Value<'_> {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        match self.as_block() {
            None => write!(f, "{}", self.as_int().unwrap()),
            Some(block) => write!(f, "{:?}", block),
        }
    }
}


// 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::FromOcamlRep;
use ocamlrep::ToOcamlRep;

#[test]
fn shared_str() {
    // Without `add_root`, converting this tuple would convert the string
    // "hello" to its OCaml representation and copy it into the ocamlrep::Arena
    // twice.
    let arena = Arena::new();
    let s = "hello";
    let tuple = (s, s);
    let ocaml_tuple = arena.add_root(&tuple);
    let ocaml_block = ocaml_tuple.as_block().unwrap();

    assert_eq!(
        ocaml_block[0].as_str(),
        Some(std::borrow::Cow::Borrowed("hello"))
    );
    assert_eq!(
        ocaml_block[1].as_str(),
        Some(std::borrow::Cow::Borrowed("hello"))
    );

    // The string pointer in the first field is physically equal to the string
    // pointer in the second field.
    assert_eq!(ocaml_block[0].to_bits(), ocaml_block[1].to_bits());
}

#[test]
fn shared_slice() {
    // Without `add_root`, converting this tuple would convert the list to its
    // OCaml representation and copy it into the ocamlrep::Arena twice.
    let arena = Arena::new();
    let s = &[1usize, 2, 3][..];
    let tuple = (s, s);
    let ocaml_tuple = arena.add_root(&tuple);

    assert_eq!(
        <(Vec<usize>, Vec<usize>)>::from_ocamlrep(ocaml_tuple),
        Ok((vec![1, 2, 3], vec![1, 2, 3]))
    );

    // The list pointer in the first field is physically equal to the list
    // pointer in the second field.
    let ocaml_block = ocaml_tuple.as_block().unwrap();
    assert_eq!(ocaml_block[0].to_bits(), ocaml_block[1].to_bits());
}

#[test]
fn overlapping_substrs() {
    // Without `Allocator::memoized_slice`, a naive implementation of
    // `ToOcamlRep` for slices might use `Allocator::memoized`, failing to take
    // the slice length into consideration.
    // Then we'd incorrectly produce the tuple ("hello", "hello").
    let arena = Arena::new();
    let s1 = "hello";
    let s2 = &s1[..4];
    let tuple = (s1, s2);
    let ocaml_tuple = arena.add_root(&tuple);

    assert_eq!(
        <(String, String)>::from_ocamlrep(ocaml_tuple),
        Ok((String::from("hello"), String::from("hell")))
    );
}

#[test]
fn overlapping_subslices() {
    // Without `Allocator::memoized_slice`, a naive implementation of
    // `ToOcamlRep` for slices might use `Allocator::memoized`, failing to take
    // the slice length into consideration.
    // Then we'd incorrectly produce the tuple ([1,2,3], [1,2,3]).
    let arena = Arena::new();
    let s1 = &[1usize, 2, 3][..];
    let s2 = &s1[..2];
    let tuple = (s1, s2);
    let ocaml_tuple = arena.add_root(&tuple);

    assert_eq!(
        <(Vec<usize>, Vec<usize>)>::from_ocamlrep(ocaml_tuple),
        Ok((vec![1, 2, 3], vec![1, 2]))
    );
}

#[derive(Debug, PartialEq)]
#[repr(transparent)]
struct U32Pair(u64);

impl U32Pair {
    fn new(fst: u32, snd: u32) -> Self {
        let fst = fst as u64;
        let snd = snd as u64;
        Self(fst << 32 | snd)
    }
    fn fst(&self) -> u32 {
        (self.0 >> 32) as u32
    }
    fn snd(&self) -> u32 {
        self.0 as u32
    }
    fn inner(&self) -> &u64 {
        &self.0
    }
}
impl ToOcamlRep for U32Pair {
    fn to_ocamlrep<'a, A: Allocator>(&'a self, alloc: &'a A) -> ocamlrep::Value<'a> {
        let mut block = alloc.block_with_size(2);
        alloc.set_field(&mut block, 0, alloc.add_copy(self.fst()));
        alloc.set_field(&mut block, 1, alloc.add_copy(self.snd()));
        block.build()
    }
}
impl FromOcamlRep for U32Pair {
    fn from_ocamlrep(value: ocamlrep::Value<'_>) -> Result<Self, ocamlrep::FromError> {
        let (fst, snd) = <(u32, u32)>::from_ocamlrep(value)?;
        Ok(Self::new(fst, snd))
    }
}

#[test]
fn differently_typed_views_of_same_data() {
    // `Allocator::memoized` is keyed solely off of address and size in bytes.
    // If we have two views of the same bytes, but the views have two different
    // OCaml representations, then `Allocator::add_root` will produce an OCaml
    // value with an unexpected type.
    //
    // Here, `pair_as_int` gets converted first, and memoized. Since its address
    // and size are the same as `pair`, the allocator uses the same memoized
    // OCaml value for both. But the implementations of `ToOcamlRep` and
    // `FromOcamlRep` for U32Pair specify that the OCaml representation is a
    // tuple, not an immediate integer, so we encounter an error when trying to
    // convert the OCaml value to `(u64, U32Pair)`.
    let arena = Arena::new();
    let pair = &U32Pair::new(1, 2);
    let pair_as_int = pair.inner();
    let value = (pair_as_int, pair);

    use ocamlrep::FromError::*;
    assert_eq!(
        <(u64, U32Pair)>::from_ocamlrep(arena.add_root(&value)),
        Err(ErrorInField(1, Box::new(ExpectedBlock(1 << 32 | 2))))
    );

    // Using arena.add instead produces a correct result.
    assert_eq!(
        <(u64, U32Pair)>::from_ocamlrep(arena.add(&value)),
        Ok((1 << 32 | 2, U32Pair::new(1, 2)))
    );
}

#[test]
fn shared_rcs() {
    use std::rc::Rc;

    let arena = Arena::new();
    let inner_tuple = Rc::new((1, 2));
    let outer_tuple = Rc::new((Rc::clone(&inner_tuple), inner_tuple));
    let ocaml_tuple = arena.add_root(&outer_tuple);
    let outer_tuple = ocaml_tuple.as_block().unwrap();

    // The tuple pointer in the first field is physically equal to the tuple
    // pointer in the second field.
    assert_eq!(outer_tuple[0].to_bits(), outer_tuple[1].to_bits());

    let inner_tuple = outer_tuple[0].as_block().unwrap();
    assert_eq!(inner_tuple[0].as_int(), Some(1));
    assert_eq!(inner_tuple[1].as_int(), Some(2));
}

#[test]
fn shared_arcs() {
    use std::sync::Arc;

    let arena = Arena::new();
    let inner_tuple = Arc::new((1, 2));
    let outer_tuple = Arc::new((Arc::clone(&inner_tuple), inner_tuple));
    let ocaml_tuple = arena.add_root(&outer_tuple);
    let outer_tuple = ocaml_tuple.as_block().unwrap();

    // The tuple pointer in the first field is physically equal to the tuple
    // pointer in the second field.
    assert_eq!(outer_tuple[0].to_bits(), outer_tuple[1].to_bits());

    let inner_tuple = outer_tuple[0].as_block().unwrap();
    assert_eq!(inner_tuple[0].as_int(), Some(1));
    assert_eq!(inner_tuple[1].as_int(), Some(2));
}


// 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.

// 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=ocamlpool.c");
    cc::Build::new()
        .include(ocamllib_dir().as_path().to_str().unwrap())
        .file("ocamlpool.c")
        .compile("ocamlpool");
}