summaryrefslogtreecommitdiff
path: root/packages/base/src
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src')
-rw-r--r--packages/base/src/Internal/Matrix.hs1
-rw-r--r--packages/base/src/Internal/Static.hs33
2 files changed, 29 insertions, 5 deletions
diff --git a/packages/base/src/Internal/Matrix.hs b/packages/base/src/Internal/Matrix.hs
index 6efbe5f..c47c625 100644
--- a/packages/base/src/Internal/Matrix.hs
+++ b/packages/base/src/Internal/Matrix.hs
@@ -5,6 +5,7 @@
5{-# LANGUAGE TypeOperators #-} 5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeFamilies #-} 6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE ViewPatterns #-} 7{-# LANGUAGE ViewPatterns #-}
8{-# LANGUAGE DeriveGeneric #-}
8{-# LANGUAGE ConstrainedClassMethods #-} 9{-# LANGUAGE ConstrainedClassMethods #-}
9 10
10-- | 11-- |
diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs
index 2c31097..a0af085 100644
--- a/packages/base/src/Internal/Static.hs
+++ b/packages/base/src/Internal/Static.hs
@@ -13,6 +13,7 @@
13{-# LANGUAGE TypeOperators #-} 13{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE ViewPatterns #-} 14{-# LANGUAGE ViewPatterns #-}
15{-# LANGUAGE BangPatterns #-} 15{-# LANGUAGE BangPatterns #-}
16{-# LANGUAGE DeriveGeneric #-}
16 17
17{- | 18{- |
18Module : Internal.Static 19Module : Internal.Static
@@ -35,13 +36,34 @@ import Data.Proxy(Proxy)
35import Foreign.Storable(Storable) 36import Foreign.Storable(Storable)
36import Text.Printf 37import Text.Printf
37 38
39import Data.Binary
40import GHC.Generics (Generic)
41import Data.Proxy (Proxy(..))
42
38-------------------------------------------------------------------------------- 43--------------------------------------------------------------------------------
39 44
40type ℝ = Double 45type ℝ = Double
41type ℂ = Complex Double 46type ℂ = Complex Double
42 47
43newtype Dim (n :: Nat) t = Dim t 48newtype Dim (n :: Nat) t = Dim t
44 deriving Show 49 deriving (Show, Generic)
50
51instance Binary a => Binary (Complex a)
52 where
53 put (r :+ i) = put (r, i)
54 get = (\(r,i) -> r :+ i) <$> get
55
56instance (KnownNat n, Binary a) => Binary (Dim n a) where
57 get = do
58 k <- get
59 let n = natVal (Proxy :: Proxy n)
60 if n == k
61 then Dim <$> get
62 else fail ("Expected dimension " ++ (show n) ++ ", but found dimension " ++ (show k))
63
64 put (Dim x) = do
65 put (natVal (Proxy :: Proxy n))
66 put x
45 67
46lift1F 68lift1F
47 :: (c t -> c t) 69 :: (c t -> c t)
@@ -59,15 +81,16 @@ instance NFData t => NFData (Dim n t) where
59-------------------------------------------------------------------------------- 81--------------------------------------------------------------------------------
60 82
61newtype R n = R (Dim n (Vector ℝ)) 83newtype R n = R (Dim n (Vector ℝ))
62 deriving (Num,Fractional,Floating) 84 deriving (Num,Fractional,Floating,Generic,Binary)
63 85
64newtype C n = C (Dim n (Vector ℂ)) 86newtype C n = C (Dim n (Vector ℂ))
65 deriving (Num,Fractional,Floating) 87 deriving (Num,Fractional,Floating,Generic,Binary)
66 88
67newtype L m n = L (Dim m (Dim n (Matrix ℝ))) 89newtype L m n = L (Dim m (Dim n (Matrix ℝ)))
90 deriving (Generic, Binary)
68 91
69newtype M m n = M (Dim m (Dim n (Matrix ℂ))) 92newtype M m n = M (Dim m (Dim n (Matrix ℂ)))
70 93 deriving (Generic, Binary)
71 94
72mkR :: Vector ℝ -> R n 95mkR :: Vector ℝ -> R n
73mkR = R . Dim 96mkR = R . Dim