diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,60 @@ +# Changelog for HROOT + +## 0.10.0.1 +- Use hackage-version of fficxx (#18) +- Generate docs in CI (#17) +- Update flake.nix with recent fficxx and ormolu format (#16) +- Update fficxx to support GHC 9.4 (#15) +- Add TMutex and test multithreading with GUI (#12) +- HROOT now uses common stdcxx (#11) +- idealized gas simulation (#10) +- Add TMarker and Range. Test 2D graphics using gas example (#9) +- HROOT generation and packing via nix (#8) +- Revive umbrella package generation (#7) +- Static files (Config.hs, Setup.lhs) and custom-setup dependency (#6) +- Modernize HROOT with fficxx 0.5.1 (#5) + +## 0.9.0.1 + +## 0.9 +- HROOT-tree +- HROOT only support ROOT > 6 + +## 0.8 +- separate packages into HROOT-core, HROOT-hist, HROOT-io, HROOT-math, HROOT-graf and HROOT is now an umbrella package + +## 0.7 +- separate all class interfaces and implementation in different modules +- overhaul Existential + +## 0.7.1 +- support for static methods +- add TROOT + +## 0.6.9 +- implement almost all class methods of TLine, TAttLine, TAttMarker, TAttText and TAttPad + +## 0.6.8 +- implement almost all class methods of TH2, TH3, TFormula, TF1 and TGraph + +## 0.6.7 +- implement almost all TH1 class methods + +## 0.6.6 +- do not need OverlappingInstances, IncoherentInstances, UndecidableInstances + +## 0.6.4 +- add many TH2 class methods + +## 0.6.3 +- Implement Existential Types + +## 0.6 +- implement Deletable. delete method for every object +- refactor HROOT generated file names (Interface.hs, Implementation.hs, FFI.hs) + +## 0.5.1 +- support for delete + +## 0.5.0 +- initial preview release 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,50 +1,55 @@ -Name: HROOT-math -Version: 0.9.0.1 -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 +Cabal-version: 3.0 +Name: HROOT-math +Version: 0.10.0.1 +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: https://wavewave.github.io/HROOT +license: LGPL-2.1-or-later +license-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim Category: Graphics, Statistics, Math, Numerical -Tested-with: GHC >= 7.6 -Build-Type: Custom -cabal-version: >=1.10 +Tested-with: GHC == 9.0.2 || == 9.2.4 || == 9.4.2 Extra-source-files: - Config.hs - csrc/HROOTMathTRandom.h - csrc/HROOTMathTRandom.cpp - - - + CHANGES + csrc/HROOTMathTRandom.h + csrc/HROOTMathTRandom.cpp +Build-Type: Custom +custom-setup + setup-depends: Cabal < 4, base > 4 && < 5, process +Source-repository head + type: git + location: https://github.com/wavewave/HROOT + Library default-language: Haskell2010 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 - cc-options: -std=c++14 - Build-Depends: base>4 && < 5, fficxx >= 0.3, fficxx-runtime >= 0.3, template-haskell,HROOT-core + cxx-options: -std=c++17 + Build-Depends: base > 4 && < 5, fficxx >= 0.7, fficxx-runtime >= 0.7, template-haskell, stdcxx, HROOT-core == 0.10.0.1 Exposed-Modules: HROOT.Math + HROOT.Math.Ordinary + HROOT.Math.Template + HROOT.Math.TH HROOT.Math.TRandom HROOT.Math.TRandom.RawType HROOT.Math.TRandom.FFI HROOT.Math.TRandom.Interface HROOT.Math.TRandom.Cast HROOT.Math.TRandom.Implementation - Other-Modules: - extra-lib-dirs: - extra-libraries: stdc++ + extra-libraries: Include-dirs: csrc + pkgconfig-depends: Install-includes: HROOT-mathType.h HROOTMathTRandom.h - - C-sources: + Cxx-sources: csrc/HROOTMathTRandom.cpp - diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,27 @@ +import Distribution.Simple +import Distribution.Simple.Setup +import Distribution.PackageDescription +import Distribution.Simple.LocalBuildInfo +import Config + +myconfigHook = simpleUserHooks { confHook = hookfunction } + +hookfunction x y = do + binfo <- confHook simpleUserHooks x y + r_pbi <- config binfo + let pkg_descr = localPkgDescr binfo + + let newbinfo = case r_pbi of + Just pbi -> binfo { localPkgDescr = updatePackageDescription pbi pkg_descr } + Nothing -> do + let r_lib = library pkg_descr + case r_lib of + Just lib -> + let binfo2 = libBuildInfo lib + newlib = lib { libBuildInfo = binfo2 { cSources = [] }} + in binfo { localPkgDescr = pkg_descr { library = Just newlib }} + Nothing -> error "some library setting is wrong." +-- putStrLn (show (localPkgDescr newbinfo)) + return newbinfo + +main = defaultMainWithHooks myconfigHook diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,33 +0,0 @@ -#! /usr/bin/env runhaskell - -> import Distribution.Simple -> import Distribution.Simple.Setup -> import Distribution.PackageDescription -> import Distribution.Simple.LocalBuildInfo -> -> import Config -> -> myconfigHook = simpleUserHooks { confHook = hookfunction } -> -> hookfunction x y = do -> binfo <- confHook simpleUserHooks x y -> r_pbi <- config binfo -> let pkg_descr = localPkgDescr binfo -> -> let newbinfo = case r_pbi of -> Just pbi -> binfo { localPkgDescr = updatePackageDescription pbi pkg_descr } -> Nothing -> do -> let r_lib = library pkg_descr -> case r_lib of -> Just lib -> -> let binfo2 = libBuildInfo lib -> newlib = lib { libBuildInfo = binfo2 { cSources = [] }} -> in binfo { localPkgDescr = pkg_descr { library = Just newlib }} -> Nothing -> error "some library setting is wrong." -> -- putStrLn (show (localPkgDescr newbinfo)) -> return newbinfo -> -> -> main = defaultMainWithHooks myconfigHook -> - diff --git a/csrc/HROOT-mathType.h b/csrc/HROOT-mathType.h --- a/csrc/HROOT-mathType.h +++ b/csrc/HROOT-mathType.h @@ -1,18 +1,12 @@ + #ifdef __cplusplus -extern "C" { +extern "C" { #endif -#ifndef __HROOT_MATH__ -#define __HROOT_MATH__ - -// Opaque type definition for TRandom -typedef struct TRandom_tag TRandom_t; -typedef TRandom_t * TRandom_p; -typedef TRandom_t const* const_TRandom_p; - - -#endif // __HROOT_MATH__ +#pragma once +// Opaque type definition for $classname +typedef struct TRandom_tag TRandom_t;typedef TRandom_t * TRandom_p;typedef TRandom_t const* const_TRandom_p; #ifdef __cplusplus } #endif diff --git a/csrc/HROOTMathTRandom.cpp b/csrc/HROOTMathTRandom.cpp --- a/csrc/HROOTMathTRandom.cpp +++ b/csrc/HROOTMathTRandom.cpp @@ -1,23 +1,25 @@ -#include + +#include "MacroPatternMatch.h" + #include "HROOTCoreTNamed.h" + #include "TRandom.h" -#include "HROOTMathTRandom.h" +#include "HROOTMathTRandom.h" +using namespace ROOT; -#define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ - IIF( CHECKPROTECT(cname,mname) ) ( \ - (to_nonconst), \ - (to_nonconst) ) - + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) TNAMED_DEF_VIRT(TRandom) TOBJECT_DEF_VIRT(TRandom) DELETABLE_DEF_VIRT(TRandom) - TRANDOM_DEF_VIRT(TRandom) - TRANDOM_DEF_NONVIRT(TRandom) +TRANDOM_DEF_ACCESSOR(TRandom) diff --git a/csrc/HROOTMathTRandom.h b/csrc/HROOTMathTRandom.h --- a/csrc/HROOTMathTRandom.h +++ b/csrc/HROOTMathTRandom.h @@ -1,66 +1,71 @@ + #ifdef __cplusplus -extern "C" { +extern "C" { #endif -#ifndef __HROOT_MATH__TRandom__ -#define __HROOT_MATH__TRandom__ +#pragma once + #include "HROOT-mathType.h" + #include "HROOTCoreTNamed.h" + #include "HROOTCoreTObject.h" -#include "HROOTCoreDeletable.h" + +#include "STDDeletable.h" + #include "HROOT-coreType.h" -#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 ) +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 + #define TRANDOM_DECL_NONVIRT(Type) \ -Type ## _p Type ## _newTRandom ( int seed ) +Type##_p Type##_newTRandom ( int seed ); -#undef TRANDOM_DEF_VIRT -#define TRANDOM_DEF_VIRT(Type)\ -int Type ## _GetSeed ( Type ## _p p )\ -{\ -return TYPECASTMETHOD(Type,GetSeed,TRandom)(p)->GetSeed();\ + +#define TRANDOM_DECL_ACCESSOR(Type) \ + + + +#define TRANDOM_DEF_VIRT(Type) \ +int Type##_GetSeed ( Type##_p p ) {\ +return ((TYPECASTMETHOD(Type, GetSeed, TRandom))(p))->GetSeed();\ }\ -double Type ## _Gaus ( Type ## _p p, double mean, double sigma )\ -{\ -return TYPECASTMETHOD(Type,Gaus,TRandom)(p)->Gaus(mean, sigma);\ +\ +double Type##_Gaus ( Type##_p p, double mean, double sigma ) {\ +return ((TYPECASTMETHOD(Type, Gaus, TRandom))(p))->Gaus(mean, sigma);\ }\ -void Type ## _SetSeed ( Type ## _p p, int seed )\ -{\ -TYPECASTMETHOD(Type,SetSeed,TRandom)(p)->SetSeed(seed);\ +\ +void Type##_SetSeed ( Type##_p p, int seed ) {\ +((TYPECASTMETHOD(Type, SetSeed, TRandom))(p))->SetSeed(seed);\ }\ -double Type ## _Uniform ( Type ## _p p, double x1, double x2 )\ -{\ -return TYPECASTMETHOD(Type,Uniform,TRandom)(p)->Uniform(x1, x2);\ +\ +double Type##_Uniform ( Type##_p p, double x1, double x2 ) {\ +return ((TYPECASTMETHOD(Type, Uniform, TRandom))(p))->Uniform(x1, x2);\ } -#undef TRANDOM_DEF_NONVIRT -#define TRANDOM_DEF_NONVIRT(Type)\ -Type ## _p Type ## _newTRandom ( int seed )\ -{\ -Type * newp = new Type (seed); \ -return to_nonconst(newp);\ + +#define TRANDOM_DEF_NONVIRT(Type) \ +Type##_p Type##_newTRandom ( int seed ) {\ +Type* newp=new Type(seed);return from_nonconst_to_nonconst(newp);\ } -TNAMED_DECL_VIRT(TRandom); -TOBJECT_DECL_VIRT(TRandom); -DELETABLE_DECL_VIRT(TRandom); +#define TRANDOM_DEF_ACCESSOR(Type) \ -TRANDOM_DECL_VIRT(TRandom); -TRANDOM_DECL_NONVIRT(TRandom); - - -#endif // __HROOT_MATH__TRandom__ +TNAMED_DECL_VIRT(TRandom) +TOBJECT_DECL_VIRT(TRandom) +DELETABLE_DECL_VIRT(TRandom) +TRANDOM_DECL_VIRT(TRandom) +TRANDOM_DECL_NONVIRT(TRandom) +TRANDOM_DECL_ACCESSOR(TRandom) #ifdef __cplusplus } diff --git a/src/HROOT/Math.hs b/src/HROOT/Math.hs --- a/src/HROOT/Math.hs +++ b/src/HROOT/Math.hs @@ -1,9 +1,10 @@ -module HROOT.Math ( - module HROOT.Math.TRandom -) where - +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI #-} +module HROOT.Math + (module HROOT.Math.TRandom, module HROOT.Math.Ordinary, + module HROOT.Math.Template, module HROOT.Math.TH) + where import HROOT.Math.TRandom - - - - +import HROOT.Math.Template +import HROOT.Math.TH +import HROOT.Math.Ordinary diff --git a/src/HROOT/Math/Ordinary.hs b/src/HROOT/Math/Ordinary.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Math/Ordinary.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI #-} +module HROOT.Math.Ordinary () where +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast diff --git a/src/HROOT/Math/TH.hs b/src/HROOT/Math/TH.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Math/TH.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI, TemplateHaskell #-} +module HROOT.Math.TH () where +import Data.Char +import Data.List +import Data.Monoid +import Foreign.C.Types +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH 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 @@ -8,10 +8,11 @@ import HROOT.Math.TRandom.RawType import HROOT.Math.TRandom.Interface -instance (ITRandom a, FPtr a) => Castable a (Ptr RawTRandom) where +instance (ITRandom a, FPtr a) => Castable (a) (Ptr RawTRandom) + where cast x f = f (castPtr (get_fptr x)) uncast x f = f (cast_fptr_to_obj (castPtr x)) -instance Castable TRandom (Ptr RawTRandom) where +instance () => Castable (TRandom) (Ptr RawTRandom) where 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,63 +1,85 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} module HROOT.Math.TRandom.FFI where +import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr import HROOT.Math.TRandom.RawType +import HROOT.Math.TRandom.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -foreign import ccall safe "HROOTMathTRandom.h TRandom_SetName" - c_trandom_setname :: Ptr RawTRandom -> CString -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_SetName" c_trandom_setname :: + Ptr RawTRandom -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_SetNameTitle" - c_trandom_setnametitle :: +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_SetNameTitle" c_trandom_setnametitle :: Ptr RawTRandom -> CString -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_SetTitle" - c_trandom_settitle :: Ptr RawTRandom -> CString -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_SetTitle" c_trandom_settitle :: + Ptr RawTRandom -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_Draw" - c_trandom_draw :: Ptr RawTRandom -> CString -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_Clear" c_trandom_clear :: + Ptr RawTRandom -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_FindObject" - c_trandom_findobject :: +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_Draw" c_trandom_draw :: + Ptr RawTRandom -> CString -> IO () + +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_FindObject" c_trandom_findobject :: Ptr RawTRandom -> CString -> IO (Ptr RawTObject) -foreign import ccall safe "HROOTMathTRandom.h TRandom_GetName" - c_trandom_getname :: Ptr RawTRandom -> IO CString +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_GetName" c_trandom_getname :: + Ptr RawTRandom -> IO CString -foreign import ccall safe "HROOTMathTRandom.h TRandom_IsA" +foreign import ccall interruptible "HROOTMathTRandom.h TRandom_IsA" c_trandom_isa :: Ptr RawTRandom -> IO (Ptr RawTClass) -foreign import ccall safe "HROOTMathTRandom.h TRandom_Paint" - c_trandom_paint :: Ptr RawTRandom -> CString -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_Paint" c_trandom_paint :: + Ptr RawTRandom -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_printObj" - c_trandom_printobj :: Ptr RawTRandom -> CString -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_printObj" c_trandom_printobj :: + Ptr RawTRandom -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_SaveAs" - c_trandom_saveas :: Ptr RawTRandom -> CString -> CString -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_SaveAs" c_trandom_saveas :: + Ptr RawTRandom -> CString -> CString -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_Write" - c_trandom_write :: +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_Write" c_trandom_write :: Ptr RawTRandom -> CString -> CInt -> CInt -> IO CInt -foreign import ccall safe "HROOTMathTRandom.h TRandom_delete" - c_trandom_delete :: Ptr RawTRandom -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_Write_" c_trandom_write_ :: + Ptr RawTRandom -> IO CInt -foreign import ccall safe "HROOTMathTRandom.h TRandom_newTRandom" - c_trandom_newtrandom :: CInt -> IO (Ptr RawTRandom) +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_delete" c_trandom_delete :: + Ptr RawTRandom -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_GetSeed" - c_trandom_getseed :: Ptr RawTRandom -> IO CInt +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_newTRandom" c_trandom_newtrandom :: + CInt -> IO (Ptr RawTRandom) -foreign import ccall safe "HROOTMathTRandom.h TRandom_Gaus" - c_trandom_gaus :: +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_GetSeed" c_trandom_getseed :: + Ptr RawTRandom -> IO CInt + +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_Gaus" c_trandom_gaus :: Ptr RawTRandom -> CDouble -> CDouble -> IO CDouble -foreign import ccall safe "HROOTMathTRandom.h TRandom_SetSeed" - c_trandom_setseed :: Ptr RawTRandom -> CInt -> IO () +foreign import ccall interruptible + "HROOTMathTRandom.h TRandom_SetSeed" c_trandom_setseed :: + Ptr RawTRandom -> CInt -> IO () -foreign import ccall safe "HROOTMathTRandom.h TRandom_Uniform" - c_trandom_uniform :: +foreign import ccall interruptible + "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,17 +1,26 @@ {-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, IncoherentInstances, - MultiParamTypeClasses, OverlappingInstances, TypeFamilies, - TypeSynonymInstances #-} + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} module HROOT.Math.TRandom.Implementation where -import FFICXX.Runtime.Cast +import Data.Monoid import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH import HROOT.Math.TRandom.RawType import HROOT.Math.TRandom.FFI import HROOT.Math.TRandom.Interface import HROOT.Math.TRandom.Cast +import HROOT.Math.TRandom.RawType +import HROOT.Math.TRandom.Cast +import HROOT.Math.TRandom.Interface import HROOT.Core.TClass.RawType import HROOT.Core.TClass.Cast import HROOT.Core.TClass.Interface @@ -21,22 +30,23 @@ import HROOT.Core.TObject.RawType import HROOT.Core.TObject.Cast import HROOT.Core.TObject.Interface -import HROOT.Core.Deletable.RawType -import HROOT.Core.Deletable.Cast -import HROOT.Core.Deletable.Interface +import STD.Deletable.RawType +import STD.Deletable.Cast +import STD.Deletable.Interface -instance ITRandom TRandom where +instance () => ITRandom (TRandom) where getSeed = xform0 c_trandom_getseed gaus = xform2 c_trandom_gaus setSeed = xform1 c_trandom_setseed uniform = xform2 c_trandom_uniform -instance ITNamed TRandom where +instance () => ITNamed (TRandom) where setName = xform1 c_trandom_setname setNameTitle = xform2 c_trandom_setnametitle setTitle = xform1 c_trandom_settitle -instance ITObject TRandom where +instance () => ITObject (TRandom) where + clear = xform1 c_trandom_clear draw = xform1 c_trandom_draw findObject = xform1 c_trandom_findobject getName = xform0 c_trandom_getname @@ -45,9 +55,10 @@ printObj = xform1 c_trandom_printobj saveAs = xform2 c_trandom_saveas write = xform3 c_trandom_write + write_ = xform0 c_trandom_write_ -instance IDeletable TRandom where +instance () => IDeletable (TRandom) where delete = xform0 c_trandom_delete -newTRandom :: CInt -> IO TRandom +newTRandom :: () => CInt -> IO TRandom newTRandom = xform0 c_trandom_newtrandom 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 @@ -4,20 +4,21 @@ TypeSynonymInstances #-} module HROOT.Math.TRandom.Interface where import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr import FFICXX.Runtime.Cast import HROOT.Math.TRandom.RawType import HROOT.Core.TNamed.Interface -class ITNamed a => ITRandom a where - getSeed :: a -> IO CInt +class (ITNamed a) => ITRandom a where + getSeed :: () => a -> IO CInt - gaus :: a -> CDouble -> CDouble -> IO CDouble + gaus :: () => a -> CDouble -> CDouble -> IO CDouble - setSeed :: a -> CInt -> IO () + setSeed :: () => a -> CInt -> IO () - uniform :: a -> CDouble -> CDouble -> IO CDouble + uniform :: () => a -> CDouble -> CDouble -> IO CDouble upcastTRandom :: forall a . (FPtr a, ITRandom a) => a -> TRandom upcastTRandom h 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 @@ -8,9 +8,9 @@ data RawTRandom newtype TRandom = TRandom (Ptr RawTRandom) - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show) -instance FPtr TRandom where +instance () => FPtr (TRandom) where type Raw TRandom = RawTRandom get_fptr (TRandom ptr) = ptr cast_fptr_to_obj = TRandom diff --git a/src/HROOT/Math/Template.hs b/src/HROOT/Math/Template.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/Math/Template.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI, MultiParamTypeClasses, + TypeFamilies #-} +module HROOT.Math.Template () where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast