diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -1,39 +0,0 @@ -0.5.0: 31 Jul 2011 - * initial preview release - -0.5.1: 3 Aug 2011 - * support for delete - -0.6: 16 Aug 2011 - * implement Deletable. delete method for every object - * refactor HROOT generated file names (Interface.hs, Implementation.hs, FFI.hs) - -0.6.3: 22 Sep 2011 - * Implement Existential Types - -0.6.4: 28 Sep 2011 - * add many TH2 class methods - -0.6.6: 7 Oct 2011 - * do not need OverlappingInstances, IncoherentInstances, UndecidableInstances - - -0.6.7: 18 Oct 2011 - * implement almost all TH1 class methods - -0.6.8: 20 Oct 2011 - * implement almost all class methods of TH2, TH3, TFormula, TF1 and TGraph - -0.6.9: 20 Oct 2011 - * implement almost all class methods of TLine, TAttLine, TAttMarker, TAttText and TAttPad - -0.7 : 8 Nov 2011 - * separate all class interfaces and implementation in different modules - * overhaul Existential - -0.7.1 : 12 Nov 2011 - * support for static methods - * add TROOT - -0.8 : 17 Jun 2014 - * separate packages into HROOT-core, HROOT-hist, HROOT-io, HROOT-math, HROOT-graf and HROOT is now an umbrella package diff --git a/Config.hs b/Config.hs deleted file mode 100644 --- a/Config.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module Config where - -import Distribution.Simple -import Distribution.Simple.Setup -import Distribution.PackageDescription -import Distribution.Simple.LocalBuildInfo - -import System.Exit -import System.Process - -config :: LocalBuildInfo -> IO (Maybe HookedBuildInfo) -config bInfo = do - (excode, out, err) <- readProcessWithExitCode "root-config" ["--glibs"] "" - liboptset' <- case excode of - ExitSuccess -> do - return . Just . mkLibraryOptionSet . words $ out - _ -> do - putStrLn $ "root-config failure but I am installing HROOT without ROOT. It will not work. This is only for documentation." - return Nothing - (excode2,out2,err2) <- readProcessWithExitCode "root-config" ["--incdir"] "" - incdir' <- case excode2 of - ExitSuccess -> do - return . Just . head . words $ out2 - _ -> do - putStrLn $ "root-config failure but I am installing HROOT without ROOT. It will not work. This is only for documentation." - return Nothing - let Just lib = library . localPkgDescr $ bInfo - buildinfo = libBuildInfo lib - let (r :: Maybe HookedBuildInfo) = case liboptset' of - Nothing -> Nothing - Just liboptset -> - case incdir' of - Nothing -> Nothing - Just incdir -> - let hbi = emptyBuildInfo { extraLibs = extraLibs buildinfo - ++ libs liboptset - , extraLibDirs = libdirs liboptset - , includeDirs = incdir : includeDirs buildinfo - } - in Just (Just hbi, []) - return r - - -data LibraryOptionSet = LibraryOptionSet { - libs :: [String], - libdirs :: [String], - libopts :: [String] -} deriving Show - -data LibraryOption = Lib String - | Dir String - | Opt String - deriving Show - -mkLibraryOptionSet :: [String] -> LibraryOptionSet -mkLibraryOptionSet strs = let opts = libraryOptions strs - in foldr f (LibraryOptionSet [] [] []) opts - where f x (LibraryOptionSet l d o) = case x of - Lib st -> LibraryOptionSet (st:l) d o - Dir st -> LibraryOptionSet l (st:d) o - Opt st -> LibraryOptionSet l d (st:o) - -libraryOptions :: [String] -> [LibraryOption] -- LibraryOptionSet -libraryOptions = map f - where f x = let r = parseLibraryOptionClassifier x - in case r of - Left msg -> error (show msg) - Right result -> result - - -parseLibraryOptionClassifier :: String -> Either String LibraryOption -parseLibraryOptionClassifier [] = Left "empty option" -parseLibraryOptionClassifier str@(x:xs) = - case x of - '-' -> if null xs - then Left "parse error" - else let (y:ys) = xs - in case y of - 'L' -> Right (Dir ys) - 'l' -> Right (Lib ys) - _ -> Right (Opt str) - _ -> Right (Opt str) - diff --git a/HROOT-math.cabal b/HROOT-math.cabal --- a/HROOT-math.cabal +++ b/HROOT-math.cabal @@ -1,19 +1,17 @@ -Name: HROOT-math -Version: 0.8 -Synopsis: Haskell binding to ROOT Math modules -Description: HROOT is a haskell Foreign Function Interface (FFI) binding to ROOT. ROOT(http://root.cern.ch) is an object-oriented program and library developed by CERN for physics data analysis. +Name: HROOT-math +Version: 0.9 +Synopsis: Haskell binding to ROOT Math modules +Description: HROOT is a haskell Foreign Function Interface (FFI) binding to ROOT. ROOT(http://root.cern.ch) is an object-oriented program and library developed by CERN for physics data analysis. Homepage: http://ianwookim.org/HROOT -License: LGPL-2.1 -License-file: LICENSE -Author: Ian-Woo Kim -Maintainer: Ian-Woo Kim +license: LGPL-2.1 +license-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim Category: Graphics, Statistics, Math, Numerical Tested-with: GHC >= 7.6 -Build-Type: Custom +Build-Type: Custom cabal-version: >=1.10 -Extra-source-files: - CHANGES - Config.hs +Extra-source-files: csrc/HROOTMathTRandom.h csrc/HROOTMathTRandom.cpp @@ -25,7 +23,8 @@ hs-source-dirs: src ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-unused-imports ghc-prof-options: -caf-all -auto-all - Build-Depends: base>4 && < 5, fficxx-runtime >= 0.0.999 ,HROOT-core + cc-options: -std=c++14 + Build-Depends: base>4 && < 5, fficxx >= 0.3, fficxx-runtime >= 0.3, template-haskell,HROOT-core Exposed-Modules: HROOT.Math HROOT.Math.TRandom @@ -34,20 +33,17 @@ HROOT.Math.TRandom.Interface HROOT.Math.TRandom.Cast HROOT.Math.TRandom.Implementation - + Other-Modules: extra-lib-dirs: extra-libraries: stdc++ - Include-dirs: csrc - Install-includes: + Include-dirs: csrc + Install-includes: HROOT-mathType.h HROOTMathTRandom.h - C-sources: + C-sources: csrc/HROOTMathTRandom.cpp - - - diff --git a/csrc/HROOT-mathType.h b/csrc/HROOT-mathType.h --- a/csrc/HROOT-mathType.h +++ b/csrc/HROOT-mathType.h @@ -10,8 +10,10 @@ typedef TRandom_t * TRandom_p; typedef TRandom_t const* const_TRandom_p; + #endif // __HROOT_MATH__ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTMathTRandom.cpp b/csrc/HROOTMathTRandom.cpp --- a/csrc/HROOTMathTRandom.cpp +++ b/csrc/HROOTMathTRandom.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTNamed.h" #include "TRandom.h" #include "HROOTMathTRandom.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -43,5 +20,4 @@ TRANDOM_DEF_VIRT(TRandom) TRANDOM_DEF_NONVIRT(TRandom) - diff --git a/csrc/HROOTMathTRandom.h b/csrc/HROOTMathTRandom.h --- a/csrc/HROOTMathTRandom.h +++ b/csrc/HROOTMathTRandom.h @@ -1,25 +1,24 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_MATH__TRandom__ #define __HROOT_MATH__TRandom__ #include "HROOT-mathType.h" - #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" #include "HROOT-coreType.h" -#undef TRANDOM_DECL_VIRT +#undef TRANDOM_DECL_VIRT #define TRANDOM_DECL_VIRT(Type) \ int Type ## _GetSeed ( Type ## _p p ); \ double Type ## _Gaus ( Type ## _p p, double mean, double sigma ); \ void Type ## _SetSeed ( Type ## _p p, int seed ); \ double Type ## _Uniform ( Type ## _p p, double x1, double x2 ) -#undef TRANDOM_DECL_NONVIRT +#undef TRANDOM_DECL_NONVIRT #define TRANDOM_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTRandom ( int seed ) @@ -66,3 +65,4 @@ #ifdef __cplusplus } #endif + diff --git a/src/HROOT/Math.hs b/src/HROOT/Math.hs --- a/src/HROOT/Math.hs +++ b/src/HROOT/Math.hs @@ -1,5 +1,5 @@ module HROOT.Math ( -module HROOT.Math.TRandom + module HROOT.Math.TRandom ) where import HROOT.Math.TRandom diff --git a/src/HROOT/Math/TRandom.hs b/src/HROOT/Math/TRandom.hs --- a/src/HROOT/Math/TRandom.hs +++ b/src/HROOT/Math/TRandom.hs @@ -1,15 +1,7 @@ module HROOT.Math.TRandom - ( - TRandom(..) - , ITRandom(..) - , upcastTRandom - , downcastTRandom - , newTRandom - - ) where - + (TRandom(..), ITRandom(..), upcastTRandom, downcastTRandom, + newTRandom) + where import HROOT.Math.TRandom.RawType import HROOT.Math.TRandom.Interface import HROOT.Math.TRandom.Implementation - - diff --git a/src/HROOT/Math/TRandom/Cast.hs b/src/HROOT/Math/TRandom/Cast.hs --- a/src/HROOT/Math/TRandom/Cast.hs +++ b/src/HROOT/Math/TRandom/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Math.TRandom.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Math.TRandom.RawType import HROOT.Math.TRandom.Interface instance (ITRandom a, FPtr a) => Castable a (Ptr RawTRandom) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TRandom (Ptr RawTRandom) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Math/TRandom/FFI.hsc b/src/HROOT/Math/TRandom/FFI.hsc --- a/src/HROOT/Math/TRandom/FFI.hsc +++ b/src/HROOT/Math/TRandom/FFI.hsc @@ -1,71 +1,63 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Math.TRandom.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Math.TRandom.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTMathTRandom.h" - -foreign import ccall "HROOTMathTRandom.h TRandom_SetName" c_trandom_setname - :: (Ptr RawTRandom) -> CString -> IO () - -foreign import ccall "HROOTMathTRandom.h TRandom_SetNameTitle" c_trandom_setnametitle - :: (Ptr RawTRandom) -> CString -> CString -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_SetName" + c_trandom_setname :: Ptr RawTRandom -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_SetTitle" c_trandom_settitle - :: (Ptr RawTRandom) -> CString -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_SetNameTitle" + c_trandom_setnametitle :: + Ptr RawTRandom -> CString -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_Draw" c_trandom_draw - :: (Ptr RawTRandom) -> CString -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_SetTitle" + c_trandom_settitle :: Ptr RawTRandom -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_FindObject" c_trandom_findobject - :: (Ptr RawTRandom) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTMathTRandom.h TRandom_Draw" + c_trandom_draw :: Ptr RawTRandom -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_GetName" c_trandom_getname - :: (Ptr RawTRandom) -> IO CString +foreign import ccall safe "HROOTMathTRandom.h TRandom_FindObject" + c_trandom_findobject :: + Ptr RawTRandom -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTMathTRandom.h TRandom_IsA" c_trandom_isa - :: (Ptr RawTRandom) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTMathTRandom.h TRandom_GetName" + c_trandom_getname :: Ptr RawTRandom -> IO CString -foreign import ccall "HROOTMathTRandom.h TRandom_Paint" c_trandom_paint - :: (Ptr RawTRandom) -> CString -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_IsA" + c_trandom_isa :: Ptr RawTRandom -> IO (Ptr RawTClass) -foreign import ccall "HROOTMathTRandom.h TRandom_printObj" c_trandom_printobj - :: (Ptr RawTRandom) -> CString -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_Paint" + c_trandom_paint :: Ptr RawTRandom -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_SaveAs" c_trandom_saveas - :: (Ptr RawTRandom) -> CString -> CString -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_printObj" + c_trandom_printobj :: Ptr RawTRandom -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_Write" c_trandom_write - :: (Ptr RawTRandom) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTMathTRandom.h TRandom_SaveAs" + c_trandom_saveas :: Ptr RawTRandom -> CString -> CString -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_delete" c_trandom_delete - :: (Ptr RawTRandom) -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_Write" + c_trandom_write :: + Ptr RawTRandom -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTMathTRandom.h TRandom_newTRandom" c_trandom_newtrandom - :: CInt -> IO (Ptr RawTRandom) +foreign import ccall safe "HROOTMathTRandom.h TRandom_delete" + c_trandom_delete :: Ptr RawTRandom -> IO () -foreign import ccall "HROOTMathTRandom.h TRandom_GetSeed" c_trandom_getseed - :: (Ptr RawTRandom) -> IO CInt +foreign import ccall safe "HROOTMathTRandom.h TRandom_newTRandom" + c_trandom_newtrandom :: CInt -> IO (Ptr RawTRandom) -foreign import ccall "HROOTMathTRandom.h TRandom_Gaus" c_trandom_gaus - :: (Ptr RawTRandom) -> CDouble -> CDouble -> IO CDouble +foreign import ccall safe "HROOTMathTRandom.h TRandom_GetSeed" + c_trandom_getseed :: Ptr RawTRandom -> IO CInt -foreign import ccall "HROOTMathTRandom.h TRandom_SetSeed" c_trandom_setseed - :: (Ptr RawTRandom) -> CInt -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_Gaus" + c_trandom_gaus :: + Ptr RawTRandom -> CDouble -> CDouble -> IO CDouble -foreign import ccall "HROOTMathTRandom.h TRandom_Uniform" c_trandom_uniform - :: (Ptr RawTRandom) -> CDouble -> CDouble -> IO CDouble +foreign import ccall safe "HROOTMathTRandom.h TRandom_SetSeed" + c_trandom_setseed :: Ptr RawTRandom -> CInt -> IO () +foreign import ccall safe "HROOTMathTRandom.h TRandom_Uniform" + c_trandom_uniform :: + Ptr RawTRandom -> CDouble -> CDouble -> IO CDouble diff --git a/src/HROOT/Math/TRandom/Implementation.hs b/src/HROOT/Math/TRandom/Implementation.hs --- a/src/HROOT/Math/TRandom/Implementation.hs +++ b/src/HROOT/Math/TRandom/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Math.TRandom.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Math.TRandom.RawType import HROOT.Math.TRandom.FFI import HROOT.Math.TRandom.Interface @@ -24,65 +25,29 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITRandom TRandom where - getSeed = xform0 c_trandom_getseed - gaus = xform2 c_trandom_gaus - setSeed = xform1 c_trandom_setseed - uniform = xform2 c_trandom_uniform + getSeed = xform0 c_trandom_getseed + gaus = xform2 c_trandom_gaus + setSeed = xform1 c_trandom_setseed + uniform = xform2 c_trandom_uniform + instance ITNamed TRandom where - setName = xform1 c_trandom_setname - setNameTitle = xform2 c_trandom_setnametitle - setTitle = xform1 c_trandom_settitle -instance ITObject TRandom where - draw = xform1 c_trandom_draw - findObject = xform1 c_trandom_findobject - getName = xform0 c_trandom_getname - isA = xform0 c_trandom_isa - paint = xform1 c_trandom_paint - printObj = xform1 c_trandom_printobj - saveAs = xform2 c_trandom_saveas - write = xform3 c_trandom_write -instance IDeletable TRandom where - delete = xform0 c_trandom_delete + setName = xform1 c_trandom_setname + setNameTitle = xform2 c_trandom_setnametitle + setTitle = xform1 c_trandom_settitle -instance ITRandom (Exist TRandom) where - getSeed (ETRandom x) = getSeed x - gaus (ETRandom x) = gaus x - setSeed (ETRandom x) = setSeed x - uniform (ETRandom x) = uniform x -instance ITNamed (Exist TRandom) where - setName (ETRandom x) = setName x - setNameTitle (ETRandom x) = setNameTitle x - setTitle (ETRandom x) = setTitle x -instance ITObject (Exist TRandom) where - draw (ETRandom x) = draw x - findObject (ETRandom x) = findObject x - getName (ETRandom x) = getName x - isA (ETRandom x) = isA x - paint (ETRandom x) = paint x - printObj (ETRandom x) = printObj x - saveAs (ETRandom x) = saveAs x - write (ETRandom x) = write x -instance IDeletable (Exist TRandom) where - delete (ETRandom x) = delete x +instance ITObject TRandom where + draw = xform1 c_trandom_draw + findObject = xform1 c_trandom_findobject + getName = xform0 c_trandom_getname + isA = xform0 c_trandom_isa + paint = xform1 c_trandom_paint + printObj = xform1 c_trandom_printobj + saveAs = xform2 c_trandom_saveas + write = xform3 c_trandom_write +instance IDeletable TRandom where + delete = xform0 c_trandom_delete newTRandom :: CInt -> IO TRandom newTRandom = xform0 c_trandom_newtrandom - - - - - -instance FPtr (Exist TRandom) where - type Raw (Exist TRandom) = RawTRandom - get_fptr (ETRandom obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETRandom (cast_fptr_to_obj (fptr :: ForeignPtr RawTRandom) :: TRandom) diff --git a/src/HROOT/Math/TRandom/Interface.hs b/src/HROOT/Math/TRandom/Interface.hs --- a/src/HROOT/Math/TRandom/Interface.hs +++ b/src/HROOT/Math/TRandom/Interface.hs @@ -1,44 +1,32 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Math.TRandom.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Math.TRandom.RawType - import HROOT.Core.TNamed.Interface ----- ============ ---- - - -class (ITNamed a) => ITRandom a where - - getSeed :: a -> IO CInt - - gaus :: a -> CDouble -> CDouble -> IO CDouble - - setSeed :: a -> CInt -> IO () - - uniform :: a -> CDouble -> CDouble -> IO CDouble - -instance Existable TRandom where - data Exist TRandom = forall a. (FPtr a, ITRandom a) => ETRandom a +class ITNamed a => ITRandom a where + getSeed :: a -> IO CInt + + gaus :: a -> CDouble -> CDouble -> IO CDouble + + setSeed :: a -> CInt -> IO () + + uniform :: a -> CDouble -> CDouble -> IO CDouble -upcastTRandom :: (FPtr a, ITRandom a) => a -> TRandom -upcastTRandom h = let fh = get_fptr h - fh2 :: ForeignPtr RawTRandom = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTRandom :: forall a . (FPtr a, ITRandom a) => a -> TRandom +upcastTRandom h + = let fh = get_fptr h + fh2 :: Ptr RawTRandom = castPtr fh + in cast_fptr_to_obj fh2 -downcastTRandom :: (FPtr a, ITRandom a) => TRandom -> a -downcastTRandom h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTRandom :: forall a . (FPtr a, ITRandom a) => TRandom -> a +downcastTRandom h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Math/TRandom/RawType.hs b/src/HROOT/Math/TRandom/RawType.hs --- a/src/HROOT/Math/TRandom/RawType.hs +++ b/src/HROOT/Math/TRandom/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Math.TRandom.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTRandom -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TRandom = TRandom (Ptr RawTRandom) + deriving (Eq, Ord, Show) -data RawTRandom -newtype TRandom = TRandom (ForeignPtr RawTRandom) deriving (Eq, Ord, Show) instance FPtr TRandom where - type Raw TRandom = RawTRandom - get_fptr (TRandom fptr) = fptr - cast_fptr_to_obj = TRandom + type Raw TRandom = RawTRandom + get_fptr (TRandom ptr) = ptr + cast_fptr_to_obj = TRandom