module Numeric.Jalla.Types (
Field1(..),
BLASEnum(..),
LAPACKEEnum(..),
Index,
Shape,
IndexPair,
rowCountTrans,
colCountTrans,
shapeTrans,
diagIndices,
Order(..),
Transpose(..),
UpLo(..),
module Data.Complex,
) where
import Data.Complex
import Data.Orphans ()
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign
import qualified Data.Tuple as T (swap)
type Index = Int
type Shape = (Index,Index)
type IndexPair = (Index,Index)
rowCountTrans :: Transpose -> Shape -> Index
rowCountTrans t (r,c) | t == Trans = c
| otherwise = r
colCountTrans :: Transpose -> Shape -> Index
colCountTrans t (r,c) | t == Trans = r
| otherwise = c
shapeTrans :: Transpose -> Shape -> Shape
shapeTrans t s | t == Trans = T.swap s
| otherwise = s
diagIndices :: Shape
-> Index
-> [IndexPair]
diagIndices (r,c) d
| d >= 0 && d < c = diagIndices' (0, d, min (c d) r)
| d < 0 && d > (r) = diagIndices' (d, 0, min (r + d) c)
| otherwise = []
where
diagIndices' :: (Index,Index,Index) -> [(Index,Index)]
diagIndices' (rstart,cstart,n) = [(rstart + i, cstart + i) | i <- [0..(max 0 (n1))]]
data Order = RowMajor | ColumnMajor deriving (Eq, Show)
data Transpose = Trans | NoTrans deriving (Eq, Show)
data UpLo = Up | Lo deriving (Eq, Show)
class BLASEnum e be where
toBlas :: e -> be
fromBlas :: be -> e
class LAPACKEEnum e le where
toLapacke :: e -> le
fromLapacke :: le -> e
f :: Complex a -> a
f _ = undefined
class (Num e, Floating e, Show e) => Field1 e where
type FieldScalar e :: *
instance Field1 CFloat where
type FieldScalar CFloat = CFloat
instance Field1 CDouble where
type FieldScalar CDouble = CDouble
instance Field1 (Complex CFloat) where
type FieldScalar (Complex CFloat) = CFloat
instance Field1 (Complex CDouble) where
type FieldScalar (Complex CDouble) = CDouble