From 71a3071a0ecc5c8ebf2b9c0a66a472ff187fdd06 Mon Sep 17 00:00:00 2001 From: Dominic Steinitz Date: Thu, 29 Mar 2018 18:11:24 +0100 Subject: Use more meaningful names --- packages/sundials/src/Bar.hsc | 9 ++++--- .../sundials/src/Numeric/Sundials/ARKode/ODE.hs | 28 +++++++--------------- packages/sundials/src/Types.hs | 14 +++-------- packages/sundials/src/helpers.h | 5 ++-- 4 files changed, 18 insertions(+), 38 deletions(-) (limited to 'packages') diff --git a/packages/sundials/src/Bar.hsc b/packages/sundials/src/Bar.hsc index 7d53af9..4fe1b4b 100644 --- a/packages/sundials/src/Bar.hsc +++ b/packages/sundials/src/Bar.hsc @@ -10,15 +10,14 @@ import Foreign.C.String #include "/Users/dom/sundials/include/nvector/nvector_serial.h" #include "/Users/dom/sundials/include/arkode/arkode.h" -#def typedef struct _generic_N_Vector BarType; -#def typedef struct _N_VectorContent_Serial BazType; - +#def typedef struct _generic_N_Vector SunVector; +#def typedef struct _N_VectorContent_Serial SunContent; getContentPtr :: Storable a => Ptr b -> IO a -getContentPtr ptr = (#peek BarType, content) ptr +getContentPtr ptr = (#peek SunVector, content) ptr getData :: Storable a => Ptr b -> IO a -getData ptr = (#peek BazType, data) ptr +getData ptr = (#peek SunContent, data) ptr arkSMax :: Int arkSMax = #const ARK_S_MAX diff --git a/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs index 44b724e..b621c58 100644 --- a/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs +++ b/packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs @@ -61,9 +61,9 @@ import qualified Types as T import Bar (sDIRK_2_1_2, kVAERNO_4_2_3) import qualified Bar as B + C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> T.sunCtx) --- C includes C.include "" C.include "" C.include "" @@ -77,26 +77,16 @@ C.include "" C.include "../../../helpers.h" --- These were semi-generated using hsc2hs with Bar.hsc as the --- template. They are probably very fragile and could easily break on --- different architectures and / or changes in the sundials package. - -getContentPtr :: Storable a => Ptr b -> IO a -getContentPtr ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr - -getData :: Storable a => Ptr b -> IO a -getData ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr - getDataFromContents :: Storable b => Int -> Ptr a -> IO (V.Vector b) getDataFromContents len ptr = do - qtr <- getContentPtr ptr - rtr <- getData qtr + qtr <- B.getContentPtr ptr + rtr <- B.getData qtr vectorFromC len rtr putDataInContents :: Storable a => V.Vector a -> Int -> Ptr b -> IO () putDataInContents vec len ptr = do - qtr <- getContentPtr ptr - rtr <- getData qtr + qtr <- B.getContentPtr ptr + rtr <- B.getData qtr vectorToC vec len rtr -- Utils @@ -199,7 +189,7 @@ solveOdeC method relTol absTol fun f0 ts = unsafePerformIO $ do diagMut <- V.thaw diagnostics -- We need the types that sundials expects. These are tied together -- in 'Types'. FIXME: The Haskell type is currently empty! - let funIO :: CDouble -> Ptr T.BarType -> Ptr T.BarType -> Ptr () -> IO CInt + let funIO :: CDouble -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr () -> IO CInt funIO x y f _ptr = do -- Convert the pointer we get from C (y) to a vector, and then -- apply the user-supplied function. @@ -240,7 +230,7 @@ solveOdeC method relTol absTol fun f0 ts = unsafePerformIO $ do /* Here we use the C types defined in helpers.h which tie up with */ /* the Haskell types defined in Types */ - flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y); + flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, SunVector y[], SunVector dydt[], void * params)), T0, y); if (check_flag(&flag, "ARKodeInit", 1)) return 1; /* Set routines */ @@ -378,7 +368,7 @@ getButcherTable method = unsafePerformIO $ do btAsMut <- V.thaw btAs -- We need the types that sundials expects. These are tied together -- in 'Types'. FIXME: The Haskell type is currently empty! - let funIO :: CDouble -> Ptr T.BarType -> Ptr T.BarType -> Ptr () -> IO CInt + let funIO :: CDouble -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr () -> IO CInt funIO x y f _ptr = do -- Convert the pointer we get from C (y) to a vector, and then -- apply the user-supplied function. @@ -411,7 +401,7 @@ getButcherTable method = unsafePerformIO $ do arkode_mem = ARKodeCreate(); /* Create the solver memory */ if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1; - flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y); + flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, SunVector y[], SunVector dydt[], void * params)), T0, y); if (check_flag(&flag, "ARKodeInit", 1)) return 1; flag = ARKodeSetIRKTableNum(arkode_mem, $(int mN)); diff --git a/packages/sundials/src/Types.hs b/packages/sundials/src/Types.hs index 9654527..e910c57 100644 --- a/packages/sundials/src/Types.hs +++ b/packages/sundials/src/Types.hs @@ -9,31 +9,23 @@ module Types where import Foreign.C.Types -import Foreign.Ptr (Ptr) - -import Foreign.Storable (Storable(..)) import qualified Language.Haskell.TH as TH import qualified Language.C.Types as CT import qualified Data.Map as Map import Language.C.Inline.Context -data BarType -instance Storable BarType where - sizeOf _ = sizeOf (undefined :: BarType) - alignment _ = alignment (undefined :: Ptr ()) - peek _ = error "peek not implemented for BarType" - poke _ _ = error "poke not implemented for BarType" +data SunVector --- This is a lie!!! +-- FIXME: Is this true? type SunIndexType = CLong sunTypesTable :: Map.Map CT.TypeSpecifier TH.TypeQ sunTypesTable = Map.fromList [ (CT.TypeName "sunindextype", [t| SunIndexType |] ) - , (CT.TypeName "BarType", [t| BarType |] ) + , (CT.TypeName "SunVector", [t| SunVector |] ) ] sunCtx :: Context diff --git a/packages/sundials/src/helpers.h b/packages/sundials/src/helpers.h index 5c1d9f3..b41ab73 100644 --- a/packages/sundials/src/helpers.h +++ b/packages/sundials/src/helpers.h @@ -8,8 +8,7 @@ #define FSYM "f" #endif -typedef struct _generic_N_Vector BarType; -typedef struct _N_VectorContent_Serial BazType; +typedef struct _generic_N_Vector SunVector; /* Check function return value... opt == 0 means SUNDIALS function allocates memory so check if @@ -17,6 +16,6 @@ typedef struct _N_VectorContent_Serial BazType; opt == 1 means SUNDIALS function returns a flag so check if flag >= 0 opt == 2 means function allocates memory so check if returned - NULL pointer + NULL pointer */ int check_flag(void *flagvalue, const char *funcname, int opt); -- cgit v1.2.3