{-# LANGUAGE EmptyDataDecls, FlexibleInstances,
  MultiParamTypeClasses, TypeFamilies #-}
module STD.SharedPtr.Template where
import Foreign.C.Types
import Foreign.Ptr
import FFICXX.Runtime.Cast

data RawSharedPtr tp1

newtype SharedPtr tp1 = SharedPtr (Ptr (RawSharedPtr tp1))

class () => ISharedPtr tp1 where
        newSharedPtr0 :: IO (SharedPtr tp1)
        
        newSharedPtr :: tp1 -> IO (SharedPtr tp1)
        
        get :: SharedPtr tp1 -> IO tp1
        
        reset :: SharedPtr tp1 -> IO ()
        
        use_count :: SharedPtr tp1 -> IO CInt
        
        deleteSharedPtr :: SharedPtr tp1 -> IO ()

instance () => FPtr (SharedPtr tp1) where
        type Raw (SharedPtr tp1) = RawSharedPtr tp1
        get_fptr :: SharedPtr tp1 -> Ptr (Raw (SharedPtr tp1))
get_fptr (SharedPtr Ptr (RawSharedPtr tp1)
ptr) = Ptr (Raw (SharedPtr tp1))
Ptr (RawSharedPtr tp1)
ptr
        cast_fptr_to_obj :: Ptr (Raw (SharedPtr tp1)) -> SharedPtr tp1
cast_fptr_to_obj = Ptr (Raw (SharedPtr tp1)) -> SharedPtr tp1
Ptr (RawSharedPtr tp1) -> SharedPtr tp1
forall tp1. Ptr (RawSharedPtr tp1) -> SharedPtr tp1
SharedPtr

instance () => Castable (SharedPtr tp1) (Ptr (RawSharedPtr tp1))
         where
        cast :: forall r. SharedPtr tp1 -> (Ptr (RawSharedPtr tp1) -> IO r) -> IO r
cast SharedPtr tp1
x Ptr (RawSharedPtr tp1) -> IO r
f = Ptr (RawSharedPtr tp1) -> IO r
f (Ptr (RawSharedPtr tp1) -> Ptr (RawSharedPtr tp1)
forall a b. Ptr a -> Ptr b
castPtr (SharedPtr tp1 -> Ptr (Raw (SharedPtr tp1))
forall a. FPtr a => a -> Ptr (Raw a)
get_fptr SharedPtr tp1
x))
        uncast :: forall r. Ptr (RawSharedPtr tp1) -> (SharedPtr tp1 -> IO r) -> IO r
uncast Ptr (RawSharedPtr tp1)
x SharedPtr tp1 -> IO r
f = SharedPtr tp1 -> IO r
f (Ptr (Raw (SharedPtr tp1)) -> SharedPtr tp1
forall a. FPtr a => Ptr (Raw a) -> a
cast_fptr_to_obj (Ptr (RawSharedPtr tp1) -> Ptr (RawSharedPtr tp1)
forall a b. Ptr a -> Ptr b
castPtr Ptr (RawSharedPtr tp1)
x))