{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} module Torch.Internal.Unmanaged.Type.IValue where import qualified Language.C.Inline.Cpp as C import qualified Language.C.Inline.Cpp.Unsafe as C import qualified Language.C.Inline.Context as C import qualified Language.C.Types as C import qualified Data.Map as Map import Foreign.C.String import Foreign.C.Types import Foreign import Torch.Internal.Type C.context $ C.cppCtx <> mempty { C.ctxTypesTable = typeTable } C.include "<ATen/core/ivalue.h>" C.include "<vector>" class IValueLike a b where toIValue :: a -> IO b fromIValue :: b -> IO a instance IValueLike (Ptr IValue) (Ptr IValue) where toIValue :: Ptr IValue -> IO (Ptr IValue) toIValue Ptr IValue _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(at::IValue* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr IValue) fromIValue Ptr IValue _obj = [C.throwBlock| at::IValue* { return new at::IValue((*$(at::IValue* _obj)).toIValue( )); }|] instance IValueLike (Ptr Tensor) (Ptr IValue) where toIValue :: Ptr Tensor -> IO (Ptr IValue) toIValue Ptr Tensor _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(at::Tensor* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr Tensor) fromIValue Ptr IValue _obj = [C.throwBlock| at::Tensor* { return new at::Tensor((*$(at::IValue* _obj)).toTensor( )); }|] instance IValueLike (Ptr (C10Ptr IVTuple)) (Ptr IValue) where toIValue :: Ptr (C10Ptr IVTuple) -> IO (Ptr IValue) toIValue Ptr (C10Ptr IVTuple) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::intrusive_ptr<at::ivalue::Tuple>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Ptr IVTuple)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::intrusive_ptr<at::ivalue::Tuple>* { return new c10::intrusive_ptr<at::ivalue::Tuple>((*$(at::IValue* _obj)).toTuple( )); }|] instance IValueLike (Ptr (C10Dict '(IValue,IValue))) (Ptr IValue) where toIValue :: Ptr (C10Dict '(IValue, IValue)) -> IO (Ptr IValue) toIValue Ptr (C10Dict '(IValue, IValue)) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::Dict<at::IValue,at::IValue>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Dict '(IValue, IValue))) fromIValue Ptr IValue _obj = [C.throwBlock| c10::Dict<at::IValue,at::IValue>* { return new c10::Dict<at::IValue,at::IValue>((*$(at::IValue* _obj)).toGenericDict( )); }|] instance IValueLike (Ptr (C10List IValue)) (Ptr IValue) where toIValue :: Ptr (C10List IValue) -> IO (Ptr IValue) toIValue Ptr (C10List IValue) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::List<at::IValue>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10List IValue)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::List<at::IValue>* { return new c10::List<at::IValue>((*$(at::IValue* _obj)).toList( )); }|] instance IValueLike (Ptr (C10List Tensor)) (Ptr IValue) where toIValue :: Ptr (C10List Tensor) -> IO (Ptr IValue) toIValue Ptr (C10List Tensor) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::List<at::Tensor>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10List Tensor)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::List<at::Tensor>* { return new c10::List<at::Tensor>((*$(at::IValue* _obj)).toTensorList( )); }|] instance IValueLike (Ptr (C10List CBool)) (Ptr IValue) where toIValue :: Ptr (C10List CBool) -> IO (Ptr IValue) toIValue Ptr (C10List CBool) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::List<bool>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10List CBool)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::List<bool>* { return new c10::List<bool>((*$(at::IValue* _obj)).toBoolList( )); }|] instance IValueLike (Ptr (C10List Int64)) (Ptr IValue) where toIValue :: Ptr (C10List Int64) -> IO (Ptr IValue) toIValue Ptr (C10List Int64) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::List<int64_t>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10List Int64)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::List<int64_t>* { return new c10::List<int64_t>((*$(at::IValue* _obj)).toIntList( )); }|] instance IValueLike (Ptr (C10List CDouble)) (Ptr IValue) where toIValue :: Ptr (C10List CDouble) -> IO (Ptr IValue) toIValue Ptr (C10List CDouble) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::List<double>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10List CDouble)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::List<double>* { return new c10::List<double>((*$(at::IValue* _obj)).toDoubleList( )); }|] instance IValueLike (Ptr (C10Ptr IVObject)) (Ptr IValue) where toIValue :: Ptr (C10Ptr IVObject) -> IO (Ptr IValue) toIValue Ptr (C10Ptr IVObject) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::intrusive_ptr<at::ivalue::Object>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Ptr IVObject)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::intrusive_ptr<at::ivalue::Object>* { return new c10::intrusive_ptr<at::ivalue::Object>((*$(at::IValue* _obj)).toObject( )); }|] instance IValueLike (Ptr (C10Ptr IVFuture)) (Ptr IValue) where toIValue :: Ptr (C10Ptr IVFuture) -> IO (Ptr IValue) toIValue Ptr (C10Ptr IVFuture) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::intrusive_ptr<at::ivalue::Future>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Ptr IVFuture)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::intrusive_ptr<at::ivalue::Future>* { return new c10::intrusive_ptr<at::ivalue::Future>((*$(at::IValue* _obj)).toFuture( )); }|] instance IValueLike (Ptr (C10Ptr IVConstantString)) (Ptr IValue) where toIValue :: Ptr (C10Ptr IVConstantString) -> IO (Ptr IValue) toIValue Ptr (C10Ptr IVConstantString) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::intrusive_ptr<at::ivalue::ConstantString>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Ptr IVConstantString)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::intrusive_ptr<at::ivalue::ConstantString>* { return new c10::intrusive_ptr<at::ivalue::ConstantString>((*$(at::IValue* _obj)).toString( )); }|] instance IValueLike (Ptr StdString) (Ptr IValue) where toIValue :: Ptr StdString -> IO (Ptr IValue) toIValue Ptr StdString _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(std::string* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr StdString) fromIValue Ptr IValue _obj = [C.throwBlock| std::string* { return new std::string((*$(at::IValue* _obj)).toStringRef( )); }|] instance IValueLike (Ptr Scalar) (Ptr IValue) where toIValue :: Ptr Scalar -> IO (Ptr IValue) toIValue Ptr Scalar _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(at::Scalar* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr Scalar) fromIValue Ptr IValue _obj = [C.throwBlock| at::Scalar* { return new at::Scalar((*$(at::IValue* _obj)).toScalar( )); }|] instance IValueLike (Ptr (C10Ptr Capsule)) (Ptr IValue) where toIValue :: Ptr (C10Ptr Capsule) -> IO (Ptr IValue) toIValue Ptr (C10Ptr Capsule) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::intrusive_ptr<torch::jit::CustomClassHolder>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Ptr Capsule)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::intrusive_ptr<torch::jit::CustomClassHolder>* { return new c10::intrusive_ptr<torch::jit::CustomClassHolder>((*$(at::IValue* _obj)).toCapsule( )); }|] instance IValueLike (Ptr (C10Ptr Blob)) (Ptr IValue) where toIValue :: Ptr (C10Ptr Blob) -> IO (Ptr IValue) toIValue Ptr (C10Ptr Blob) _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::intrusive_ptr<caffe2::Blob>* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr (C10Ptr Blob)) fromIValue Ptr IValue _obj = [C.throwBlock| c10::intrusive_ptr<caffe2::Blob>* { return new c10::intrusive_ptr<caffe2::Blob>((*$(at::IValue* _obj)).toBlob( )); }|] instance IValueLike CDouble (Ptr IValue) where toIValue :: CDouble -> IO (Ptr IValue) toIValue CDouble _x = [C.throwBlock| at::IValue* { return new at::IValue( $(double _x)); }|] fromIValue :: Ptr IValue -> IO CDouble fromIValue Ptr IValue _obj = [C.throwBlock| double { return ((*$(at::IValue* _obj)).toDouble( )); }|] instance IValueLike Int64 (Ptr IValue) where toIValue :: Int64 -> IO (Ptr IValue) toIValue Int64 _x = [C.throwBlock| at::IValue* { return new at::IValue( $(int64_t _x)); }|] fromIValue :: Ptr IValue -> IO Int64 fromIValue Ptr IValue _obj = [C.throwBlock| int64_t { return ((*$(at::IValue* _obj)).toInt( )); }|] instance IValueLike Int32 (Ptr IValue) where toIValue :: Int32 -> IO (Ptr IValue) toIValue Int32 _x = [C.throwBlock| at::IValue* { return new at::IValue( $(int32_t _x)); }|] fromIValue :: Ptr IValue -> IO Int32 fromIValue Ptr IValue _obj = [C.throwBlock| int32_t { return ((*$(at::IValue* _obj)).toInt( )); }|] instance IValueLike CBool (Ptr IValue) where toIValue :: CBool -> IO (Ptr IValue) toIValue CBool _x = [C.throwBlock| at::IValue* { return new at::IValue( $(bool _x)); }|] fromIValue :: Ptr IValue -> IO CBool fromIValue Ptr IValue _obj = [C.throwBlock| bool { return ((*$(at::IValue* _obj)).toBool( )); }|] instance IValueLike (Ptr Device) (Ptr IValue) where toIValue :: Ptr Device -> IO (Ptr IValue) toIValue Ptr Device _x = [C.throwBlock| at::IValue* { return new at::IValue( *$(c10::Device* _x)); }|] fromIValue :: Ptr IValue -> IO (Ptr Device) fromIValue Ptr IValue _obj = [C.throwBlock| c10::Device* { return new c10::Device((*$(at::IValue* _obj)).toDevice( )); }|] newIValue :: IO (Ptr IValue) newIValue :: IO (Ptr IValue) newIValue = [C.throwBlock| at::IValue* { return new at::IValue() ; }|] iValue_isAliasOf_V :: Ptr IValue -> Ptr IValue -> IO (CBool) iValue_isAliasOf_V :: Ptr IValue -> Ptr IValue -> IO CBool iValue_isAliasOf_V Ptr IValue _obj Ptr IValue _rhs = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isAliasOf( *$(at::IValue* _rhs)); }|] iValue_use_count :: Ptr IValue -> IO (CSize) iValue_use_count :: Ptr IValue -> IO CSize iValue_use_count Ptr IValue _obj = [C.throwBlock| size_t { return (*$(at::IValue* _obj)).use_count( ); }|] iValue_swap_V :: Ptr IValue -> Ptr IValue -> IO (()) iValue_swap_V :: Ptr IValue -> Ptr IValue -> IO () iValue_swap_V Ptr IValue _obj Ptr IValue _rhs = [C.throwBlock| void { (*$(at::IValue* _obj)).swap( *$(at::IValue* _rhs)); }|] iValue_isTensor :: Ptr IValue -> IO (CBool) iValue_isTensor :: Ptr IValue -> IO CBool iValue_isTensor Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isTensor( ); }|] iValue_isBlob :: Ptr IValue -> IO (CBool) iValue_isBlob :: Ptr IValue -> IO CBool iValue_isBlob Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isBlob( ); }|] iValue_isCapsule :: Ptr IValue -> IO (CBool) iValue_isCapsule :: Ptr IValue -> IO CBool iValue_isCapsule Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isCapsule( ); }|] iValue_isTuple :: Ptr IValue -> IO (CBool) iValue_isTuple :: Ptr IValue -> IO CBool iValue_isTuple Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isTuple( ); }|] iValue_isDouble :: Ptr IValue -> IO (CBool) iValue_isDouble :: Ptr IValue -> IO CBool iValue_isDouble Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isDouble( ); }|] iValue_isFuture :: Ptr IValue -> IO (CBool) iValue_isFuture :: Ptr IValue -> IO CBool iValue_isFuture Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isFuture( ); }|] iValue_isInt :: Ptr IValue -> IO (CBool) iValue_isInt :: Ptr IValue -> IO CBool iValue_isInt Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isInt( ); }|] iValue_isIntList :: Ptr IValue -> IO (CBool) iValue_isIntList :: Ptr IValue -> IO CBool iValue_isIntList Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isIntList( ); }|] iValue_isString :: Ptr IValue -> IO (CBool) iValue_isString :: Ptr IValue -> IO CBool iValue_isString Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isString( ); }|] iValue_toStringRef :: Ptr IValue -> IO (Ptr StdString) iValue_toStringRef :: Ptr IValue -> IO (Ptr StdString) iValue_toStringRef Ptr IValue _obj = [C.throwBlock| std::string* { return new std::string((*$(at::IValue* _obj)).toStringRef( )); }|] iValue_isDoubleList :: Ptr IValue -> IO (CBool) iValue_isDoubleList :: Ptr IValue -> IO CBool iValue_isDoubleList Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isDoubleList( ); }|] iValue_isBool :: Ptr IValue -> IO (CBool) iValue_isBool :: Ptr IValue -> IO CBool iValue_isBool Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isBool( ); }|] iValue_isObject :: Ptr IValue -> IO (CBool) iValue_isObject :: Ptr IValue -> IO CBool iValue_isObject Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isObject( ); }|] iValue_isBoolList :: Ptr IValue -> IO (CBool) iValue_isBoolList :: Ptr IValue -> IO CBool iValue_isBoolList Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isBoolList( ); }|] iValue_isTensorList :: Ptr IValue -> IO (CBool) iValue_isTensorList :: Ptr IValue -> IO CBool iValue_isTensorList Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isTensorList( ); }|] iValue_isList :: Ptr IValue -> IO (CBool) iValue_isList :: Ptr IValue -> IO CBool iValue_isList Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isList( ); }|] iValue_isGenericDict :: Ptr IValue -> IO (CBool) iValue_isGenericDict :: Ptr IValue -> IO CBool iValue_isGenericDict Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isGenericDict( ); }|] iValue_isNone :: Ptr IValue -> IO (CBool) iValue_isNone :: Ptr IValue -> IO CBool iValue_isNone Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isNone( ); }|] iValue_toNone :: Ptr IValue -> IO (Ptr StdString) iValue_toNone :: Ptr IValue -> IO (Ptr StdString) iValue_toNone Ptr IValue _obj = [C.throwBlock| std::string* { return new std::string((*$(at::IValue* _obj)).toNone( )); }|] iValue_isScalar :: Ptr IValue -> IO (CBool) iValue_isScalar :: Ptr IValue -> IO CBool iValue_isScalar Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isScalar( ); }|] iValue_isDevice :: Ptr IValue -> IO (CBool) iValue_isDevice :: Ptr IValue -> IO CBool iValue_isDevice Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isDevice( ); }|] iValue_toScalarType :: Ptr IValue -> IO (ScalarType) iValue_toScalarType :: Ptr IValue -> IO ScalarType iValue_toScalarType Ptr IValue _obj = [C.throwBlock| at::ScalarType { return (*$(at::IValue* _obj)).toScalarType( ); }|] iValue_toLayout :: Ptr IValue -> IO (Layout) iValue_toLayout :: Ptr IValue -> IO ScalarType iValue_toLayout Ptr IValue _obj = [C.throwBlock| at::Layout { return (*$(at::IValue* _obj)).toLayout( ); }|] iValue_toMemoryFormat :: Ptr IValue -> IO (MemoryFormat) iValue_toMemoryFormat :: Ptr IValue -> IO ScalarType iValue_toMemoryFormat Ptr IValue _obj = [C.throwBlock| at::MemoryFormat { return (*$(at::IValue* _obj)).toMemoryFormat( ); }|] iValue_toQScheme :: Ptr IValue -> IO (QScheme) iValue_toQScheme :: Ptr IValue -> IO ScalarType iValue_toQScheme Ptr IValue _obj = [C.throwBlock| at::QScheme { return (*$(at::IValue* _obj)).toQScheme( ); }|] iValue_tagKind :: Ptr IValue -> IO (Ptr StdString) iValue_tagKind :: Ptr IValue -> IO (Ptr StdString) iValue_tagKind Ptr IValue _obj = [C.throwBlock| std::string* { return new std::string((*$(at::IValue* _obj)).tagKind( )); }|] iValue_isSameIdentity_V :: Ptr IValue -> Ptr IValue -> IO (CBool) iValue_isSameIdentity_V :: Ptr IValue -> Ptr IValue -> IO CBool iValue_isSameIdentity_V Ptr IValue _obj Ptr IValue _rhs = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isSameIdentity( *$(at::IValue* _rhs)); }|] iValue_isPtrType :: Ptr IValue -> IO (CBool) iValue_isPtrType :: Ptr IValue -> IO CBool iValue_isPtrType Ptr IValue _obj = [C.throwBlock| bool { return (*$(at::IValue* _obj)).isPtrType( ); }|]