summaryrefslogtreecommitdiff
path: root/packages/sundials/src/Numeric/Sundials
diff options
context:
space:
mode:
authorDominic Steinitz <dominic@steinitz.org>2018-03-29 18:11:24 +0100
committerDominic Steinitz <dominic@steinitz.org>2018-03-29 18:11:24 +0100
commit71a3071a0ecc5c8ebf2b9c0a66a472ff187fdd06 (patch)
tree4067975ada9ba1563bf535b30f98d84cf3c7c209 /packages/sundials/src/Numeric/Sundials
parent348235b04519f7420a2149e979d076302f869ed9 (diff)
Use more meaningful names
Diffstat (limited to 'packages/sundials/src/Numeric/Sundials')
-rw-r--r--packages/sundials/src/Numeric/Sundials/ARKode/ODE.hs28
1 files changed, 9 insertions, 19 deletions
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
61import Bar (sDIRK_2_1_2, kVAERNO_4_2_3) 61import Bar (sDIRK_2_1_2, kVAERNO_4_2_3)
62import qualified Bar as B 62import qualified Bar as B
63 63
64
64C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> T.sunCtx) 65C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> T.sunCtx)
65 66
66-- C includes
67C.include "<stdlib.h>" 67C.include "<stdlib.h>"
68C.include "<stdio.h>" 68C.include "<stdio.h>"
69C.include "<math.h>" 69C.include "<math.h>"
@@ -77,26 +77,16 @@ C.include "<sundials/sundials_math.h>"
77C.include "../../../helpers.h" 77C.include "../../../helpers.h"
78 78
79 79
80-- These were semi-generated using hsc2hs with Bar.hsc as the
81-- template. They are probably very fragile and could easily break on
82-- different architectures and / or changes in the sundials package.
83
84getContentPtr :: Storable a => Ptr b -> IO a
85getContentPtr ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
86
87getData :: Storable a => Ptr b -> IO a
88getData ptr = ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
89
90getDataFromContents :: Storable b => Int -> Ptr a -> IO (V.Vector b) 80getDataFromContents :: Storable b => Int -> Ptr a -> IO (V.Vector b)
91getDataFromContents len ptr = do 81getDataFromContents len ptr = do
92 qtr <- getContentPtr ptr 82 qtr <- B.getContentPtr ptr
93 rtr <- getData qtr 83 rtr <- B.getData qtr
94 vectorFromC len rtr 84 vectorFromC len rtr
95 85
96putDataInContents :: Storable a => V.Vector a -> Int -> Ptr b -> IO () 86putDataInContents :: Storable a => V.Vector a -> Int -> Ptr b -> IO ()
97putDataInContents vec len ptr = do 87putDataInContents vec len ptr = do
98 qtr <- getContentPtr ptr 88 qtr <- B.getContentPtr ptr
99 rtr <- getData qtr 89 rtr <- B.getData qtr
100 vectorToC vec len rtr 90 vectorToC vec len rtr
101 91
102-- Utils 92-- Utils
@@ -199,7 +189,7 @@ solveOdeC method relTol absTol fun f0 ts = unsafePerformIO $ do
199 diagMut <- V.thaw diagnostics 189 diagMut <- V.thaw diagnostics
200 -- We need the types that sundials expects. These are tied together 190 -- We need the types that sundials expects. These are tied together
201 -- in 'Types'. FIXME: The Haskell type is currently empty! 191 -- in 'Types'. FIXME: The Haskell type is currently empty!
202 let funIO :: CDouble -> Ptr T.BarType -> Ptr T.BarType -> Ptr () -> IO CInt 192 let funIO :: CDouble -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr () -> IO CInt
203 funIO x y f _ptr = do 193 funIO x y f _ptr = do
204 -- Convert the pointer we get from C (y) to a vector, and then 194 -- Convert the pointer we get from C (y) to a vector, and then
205 -- apply the user-supplied function. 195 -- apply the user-supplied function.
@@ -240,7 +230,7 @@ solveOdeC method relTol absTol fun f0 ts = unsafePerformIO $ do
240 230
241 /* Here we use the C types defined in helpers.h which tie up with */ 231 /* Here we use the C types defined in helpers.h which tie up with */
242 /* the Haskell types defined in Types */ 232 /* the Haskell types defined in Types */
243 flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y); 233 flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, SunVector y[], SunVector dydt[], void * params)), T0, y);
244 if (check_flag(&flag, "ARKodeInit", 1)) return 1; 234 if (check_flag(&flag, "ARKodeInit", 1)) return 1;
245 235
246 /* Set routines */ 236 /* Set routines */
@@ -378,7 +368,7 @@ getButcherTable method = unsafePerformIO $ do
378 btAsMut <- V.thaw btAs 368 btAsMut <- V.thaw btAs
379 -- We need the types that sundials expects. These are tied together 369 -- We need the types that sundials expects. These are tied together
380 -- in 'Types'. FIXME: The Haskell type is currently empty! 370 -- in 'Types'. FIXME: The Haskell type is currently empty!
381 let funIO :: CDouble -> Ptr T.BarType -> Ptr T.BarType -> Ptr () -> IO CInt 371 let funIO :: CDouble -> Ptr T.SunVector -> Ptr T.SunVector -> Ptr () -> IO CInt
382 funIO x y f _ptr = do 372 funIO x y f _ptr = do
383 -- Convert the pointer we get from C (y) to a vector, and then 373 -- Convert the pointer we get from C (y) to a vector, and then
384 -- apply the user-supplied function. 374 -- apply the user-supplied function.
@@ -411,7 +401,7 @@ getButcherTable method = unsafePerformIO $ do
411 arkode_mem = ARKodeCreate(); /* Create the solver memory */ 401 arkode_mem = ARKodeCreate(); /* Create the solver memory */
412 if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1; 402 if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1;
413 403
414 flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, BarType y[], BarType dydt[], void * params)), T0, y); 404 flag = ARKodeInit(arkode_mem, NULL, $fun:(int (* funIO) (double t, SunVector y[], SunVector dydt[], void * params)), T0, y);
415 if (check_flag(&flag, "ARKodeInit", 1)) return 1; 405 if (check_flag(&flag, "ARKodeInit", 1)) return 1;
416 406
417 flag = ARKodeSetIRKTableNum(arkode_mem, $(int mN)); 407 flag = ARKodeSetIRKTableNum(arkode_mem, $(int mN));