From 8bdb87764762ef43b186bcc04caa404928df22fa Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Mon, 1 Feb 2016 17:40:40 -0600 Subject: some work (will probably undo this commit later) --- packages/base/src/Internal/Matrix.hs | 1 + packages/base/src/Internal/Static.hs | 25 +++++++++++++++++++++---- 2 files changed, 22 insertions(+), 4 deletions(-) (limited to 'packages/base/src/Internal') diff --git a/packages/base/src/Internal/Matrix.hs b/packages/base/src/Internal/Matrix.hs index 3082e8d..f9b02ca 100644 --- a/packages/base/src/Internal/Matrix.hs +++ b/packages/base/src/Internal/Matrix.hs @@ -5,6 +5,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveGeneric #-} diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs index 419ff07..0ad2cad 100644 --- a/packages/base/src/Internal/Static.hs +++ b/packages/base/src/Internal/Static.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE DataKinds #-} @@ -12,6 +13,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} {- | Module : Internal.Static @@ -33,6 +35,8 @@ import Control.DeepSeq import Data.Proxy(Proxy) import Foreign.Storable(Storable) import Text.Printf +import Data.Binary +import GHC.Generics (Generic) -------------------------------------------------------------------------------- @@ -40,7 +44,14 @@ type ℝ = Double type ℂ = Complex Double newtype Dim (n :: Nat) t = Dim t - deriving Show + deriving (Show, Generic) + +instance Binary a => Binary (Complex a) + where + put (r :+ i) = put (r, i) + get = (\(r,i) -> r :+ i) <$> get + +instance (Binary a) => Binary (Dim n a) lift1F :: (c t -> c t) @@ -58,15 +69,21 @@ instance NFData t => NFData (Dim n t) where -------------------------------------------------------------------------------- newtype R n = R (Dim n (Vector ℝ)) - deriving (Num,Fractional,Floating) + deriving (Num,Fractional,Floating,Generic) newtype C n = C (Dim n (Vector ℂ)) - deriving (Num,Fractional,Floating) + deriving (Num,Fractional,Floating,Generic) newtype L m n = L (Dim m (Dim n (Matrix ℝ))) + deriving (Generic) -newtype M m n = M (Dim m (Dim n (Matrix ℂ))) +newtype M m n = M (Dim m (Dim n (Matrix ℂ))) + deriving (Generic) +instance (KnownNat n) => Binary (R n) +instance (KnownNat n) => Binary (C n) +instance (KnownNat m, KnownNat n) => Binary (L m n) +instance (KnownNat m, KnownNat n) => Binary (M m n) mkR :: Vector ℝ -> R n mkR = R . Dim -- cgit v1.2.3 From 3824df2f2f17c8395832b88b27d61fdc22553f2e Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Sun, 13 Mar 2016 15:30:43 -0500 Subject: Simplify binary instances --- packages/base/src/Internal/Static.hs | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) (limited to 'packages/base/src/Internal') diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs index 1e9a5a3..058b9d0 100644 --- a/packages/base/src/Internal/Static.hs +++ b/packages/base/src/Internal/Static.hs @@ -69,21 +69,16 @@ instance NFData t => NFData (Dim n t) where -------------------------------------------------------------------------------- newtype R n = R (Dim n (Vector ℝ)) - deriving (Num,Fractional,Floating,Generic) + deriving (Num,Fractional,Floating,Generic,Binary) newtype C n = C (Dim n (Vector ℂ)) - deriving (Num,Fractional,Floating,Generic) + deriving (Num,Fractional,Floating,Generic,Binary) newtype L m n = L (Dim m (Dim n (Matrix ℝ))) - deriving (Generic) + deriving (Generic, Binary) newtype M m n = M (Dim m (Dim n (Matrix ℂ))) - deriving (Generic) - -instance (KnownNat n) => Binary (R n) -instance (KnownNat n) => Binary (C n) -instance (KnownNat m, KnownNat n) => Binary (L m n) -instance (KnownNat m, KnownNat n) => Binary (M m n) + deriving (Generic, Binary) mkR :: Vector ℝ -> R n mkR = R . Dim -- cgit v1.2.3 From 91e9c879bfa3b509cd737ba31580cbba0c0bf340 Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Sun, 13 Mar 2016 17:25:23 -0500 Subject: Add dimension check in Dim binary instance --- packages/base/src/Internal/Static.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'packages/base/src/Internal') diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs index 058b9d0..a0af085 100644 --- a/packages/base/src/Internal/Static.hs +++ b/packages/base/src/Internal/Static.hs @@ -35,8 +35,10 @@ import Control.DeepSeq import Data.Proxy(Proxy) import Foreign.Storable(Storable) import Text.Printf + import Data.Binary import GHC.Generics (Generic) +import Data.Proxy (Proxy(..)) -------------------------------------------------------------------------------- @@ -51,7 +53,17 @@ instance Binary a => Binary (Complex a) put (r :+ i) = put (r, i) get = (\(r,i) -> r :+ i) <$> get -instance (Binary a) => Binary (Dim n a) +instance (KnownNat n, Binary a) => Binary (Dim n a) where + get = do + k <- get + let n = natVal (Proxy :: Proxy n) + if n == k + then Dim <$> get + else fail ("Expected dimension " ++ (show n) ++ ", but found dimension " ++ (show k)) + + put (Dim x) = do + put (natVal (Proxy :: Proxy n)) + put x lift1F :: (c t -> c t) -- cgit v1.2.3