easytensor 0.2.0.0 → 0.3.0.0
raw patch · 53 files changed
+6965/−4171 lines, 53 filesdep +ghcjs-basePVP ok
version bump matches the API change (PVP)
Dependencies added: ghcjs-base
API changes (from Hackage documentation)
+ Numeric.DataFrame: indexOffset# :: SubSpace t as bs asbs => Int# -> Int# -> DataFrame t asbs -> DataFrame t as
- Numeric.DataFrame: class (ConcatList as bs asbs, Dimensions as, Dimensions bs, Dimensions asbs) => SubSpace (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) | asbs as -> bs, asbs bs -> as, as bs -> asbs
+ Numeric.DataFrame: class (ConcatList as bs asbs, Dimensions as, Dimensions bs, Dimensions asbs) => SubSpace (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) | asbs as -> bs, asbs bs -> as, as bs -> asbs where (!.) i = case (# dimVal (dim @as), fromEnum i #) of { (# I# n, I# j #) -> indexOffset# (n *# j) n }
- Numeric.Matrix: det :: SquareMatrixCalculus t n => Matrix t n n -> t
+ Numeric.Matrix: det :: SquareMatrixCalculus t n => Matrix t n n -> Scalar t
Files
- bench/subspacefolds.hs +21/−11
- easytensor.cabal +28/−14
- src-base/Numeric/Array.hs +33/−0
- src-base/Numeric/Array/Family.hs +429/−0
- src-base/Numeric/Array/Family/Array.h +308/−0
- src-base/Numeric/Array/Family/ArrayD.hs +408/−0
- src-base/Numeric/Array/Family/ArrayF.hs +412/−0
- src-base/Numeric/Array/Family/ArrayI.hs +95/−0
- src-base/Numeric/Array/Family/ArrayI16.hs +96/−0
- src-base/Numeric/Array/Family/ArrayI32.hs +96/−0
- src-base/Numeric/Array/Family/ArrayI64.hs +96/−0
- src-base/Numeric/Array/Family/ArrayI8.hs +96/−0
- src-base/Numeric/Array/Family/ArrayW.hs +89/−0
- src-base/Numeric/Array/Family/ArrayW16.hs +90/−0
- src-base/Numeric/Array/Family/ArrayW32.hs +90/−0
- src-base/Numeric/Array/Family/ArrayW64.hs +90/−0
- src-base/Numeric/Array/Family/ArrayW8.hs +90/−0
- src-base/Numeric/Array/Family/FloatX2.hs +325/−0
- src-base/Numeric/Array/Family/FloatX3.hs +299/−0
- src-base/Numeric/Array/Family/FloatX4.hs +335/−0
- src-base/Numeric/DataFrame/Contraction.hs +509/−0
- src-base/Numeric/DataFrame/Inference.hs +140/−0
- src-ghcjs/Numeric/Array.hs +18/−0
- src-ghcjs/Numeric/Array/Family.hs +345/−0
- src-ghcjs/Numeric/Array/Family/ArrayT.hs +1642/−0
- src-ghcjs/Numeric/Array/Family/ArrayT.js +444/−0
- src-ghcjs/Numeric/DataFrame/Contraction.hs +78/−0
- src-ghcjs/Numeric/DataFrame/Inference.hs +127/−0
- src/Numeric/Array.hs +0/−33
- src/Numeric/Array/ElementWise.hs +40/−3
- src/Numeric/Array/Family.hs +0/−422
- src/Numeric/Array/Family/Array.h +0/−305
- src/Numeric/Array/Family/ArrayD.hs +0/−408
- src/Numeric/Array/Family/ArrayF.hs +0/−412
- src/Numeric/Array/Family/ArrayI.hs +0/−95
- src/Numeric/Array/Family/ArrayI16.hs +0/−96
- src/Numeric/Array/Family/ArrayI32.hs +0/−96
- src/Numeric/Array/Family/ArrayI64.hs +0/−96
- src/Numeric/Array/Family/ArrayI8.hs +0/−96
- src/Numeric/Array/Family/ArrayW.hs +0/−89
- src/Numeric/Array/Family/ArrayW16.hs +0/−90
- src/Numeric/Array/Family/ArrayW32.hs +0/−90
- src/Numeric/Array/Family/ArrayW64.hs +0/−90
- src/Numeric/Array/Family/ArrayW8.hs +0/−90
- src/Numeric/Array/Family/FloatX2.hs +0/−321
- src/Numeric/Array/Family/FloatX3.hs +0/−294
- src/Numeric/Array/Family/FloatX4.hs +0/−329
- src/Numeric/Commons.hs +23/−0
- src/Numeric/DataFrame/Contraction.hs +0/−535
- src/Numeric/DataFrame/Inference.hs +0/−140
- src/Numeric/DataFrame/SubSpace.hs +55/−15
- src/Numeric/DataFrame/Type.hs +17/−0
- src/Numeric/Matrix/Type.hs +1/−1
bench/subspacefolds.hs view
@@ -12,7 +12,7 @@ import Numeric.Dimensions -type DList = [6,8,10,7,35,8,12] -- [6,26,8,10,35,8,12]+type DList = [6,4,10,7,35,8,12] -- [6,26,8,10,35,8,12] main :: IO () main = do@@ -23,45 +23,55 @@ seq t1 putStrLn $ "Created DataFrame, elapsed time is " ++ show (diffUTCTime t1 t0) putStrLn "\nRunning a ewfoldl on scalar elements..."- let rezEwf = ewfoldl @Float @'[] @DList (\a x -> let z = fromMaybe x a + fromMaybe 0 a / (x+1) in z `seq` return z) (Just 1) df+ let rezEwf = ewfoldl @Float @'[] @DList (\a x -> return $! fromMaybe x a + fromMaybe 0 a / (x+1)) (Just 1) df t2 <- rezEwf `seq` getCurrentTime- print rezEwf seq t2 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t2 t1)+ print rezEwf putStrLn "\nRunning a iwfoldl on scalar elements (not using idx)..." let rezIwf = iwfoldl @Float @'[] @DList (\_ a x -> a + a / (x+1)) 1 df t3 <- rezIwf `seq` getCurrentTime- print rezIwf seq t3 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t3 t2)+ print rezIwf putStrLn "\nRunning a iwfoldr on scalar elements (using fromEnum idx)..."- let rezIwf2 = iwfoldr @Float @'[] @DList (\i x a -> let z = fromMaybe 0 a + x / ((1+) . fromIntegral $ fromEnum i) in z `seq` return z) (Just 0) df+ let rezIwf2 = iwfoldr @Float @'[] @DList (\i x a -> return $! fromMaybe 0 a + x / ((1+) . fromIntegral $ fromEnum i)) (Just 0) df t4 <- rezIwf2 `seq` getCurrentTime- print rezIwf2 seq t4 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t4 t3)+ print rezIwf2 putStrLn "\nRunning a iwfoldl on scalar elements (enforcing idx)..."- let rezIwf3 = iwfoldl @Float @'[] @DList (\i a x -> i `seq` let z = fromMaybe 0 a + fromMaybe x a / (x+1) in z `seq` return z) (Just 1) df+ let rezIwf3 = iwfoldl @Float @'[] @DList (\i a x -> i `seq` return $! fromMaybe 0 a + fromMaybe x a / (x+1)) (Just 1) df t5 <- rezIwf3 `seq` getCurrentTime- print rezIwf3 seq t5 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t5 t4)+ print rezIwf3 putStrLn "\nRunning a ewfoldl on vector5 elements..." let rezEwv1 = ewfoldl @Float @'[Head DList] @(Tail DList) (\a x -> return $! fromMaybe 2 a + fromMaybe 0 a / (1 + iwgen @_ @'[] (\(i:!Z) -> (i+1):!Z !. x )) ) (Just (3 :: DataFrame Float '[5])) df t6 <- rezEwv1 `seq` getCurrentTime- print rezEwv1 seq t6 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t6 t5)+ print rezEwv1 putStrLn "\nRunning a ewfoldr on vector3 elements..." let rezEwv2 = ewfoldr @Float @'[Head DList] @(Tail DList) (\x a -> return $! fromMaybe 2 a + fromMaybe 1 a / (1 + iwgen @_ @'[] (\(i:!Z) -> (i+1):!Z !. x ))) (Just (3 :: DataFrame Float '[3])) df t7 <- rezEwv2 `seq` getCurrentTime- print rezEwv2 seq t7 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t7 t6)+ print rezEwv2 + putStrLn "\nRunning a ewfoldr with matrix products..."+ let rezEwm = ewfoldr @Float @(Take 3 DList) @(Drop 3 DList)+ (\x a -> a + x %* (1 <::> 0.5 <:> 0.1) )+ (1 :: DataFrame Float (Take 2 DList +: 3)) df+ t8 <- rezEwm `seq` getCurrentTime+ seq t8 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t8 t7)+ print rezEwm +++ putStrLn "Checking indexes"- print $ 1:!1:!3:!1:!Z !. df+ print $ 2:!1:!1:!3:!1:!Z !. df
easytensor.cabal view
@@ -1,5 +1,5 @@ name: easytensor-version: 0.2.0.0+version: 0.3.0.0 cabal-version: >=1.20 build-type: Simple license: MIT@@ -7,16 +7,16 @@ copyright: (c) Artem Chirkin maintainer: chirkin@arch.ethz.ch homepage: https://github.com/achirkin/easytensor#readme-synopsis: Initial project template from stack+synopsis: Pure, type-indexed haskell vector, matrix, and tensor library. description:- Pure haskell vector/matrix/tensor library.+ Pure, type-indexed haskell vector, matrix, and tensor library. Features dimensionality type-checking for all operations. Generic n-dimensional versions are implemented using low-level prim ops. Allows ad-hoc replacement with fixed low-dimensionality vectors and matrices without changing user interface. category: Math, Geometry author: Artem Chirkin extra-source-files:- src/Numeric/Array/Family/Array.h+ src-base/Numeric/Array/Family/Array.h source-repository head type: git@@ -46,9 +46,31 @@ base >=4.9 && <5, ghc-prim >=0.5, dimensions -any+ if impl(ghcjs)+ build-depends:+ ghcjs-base >= 0.2.0.0 default-language: Haskell2010 hs-source-dirs: src+ if impl(ghcjs)+ hs-source-dirs: src-ghcjs+ else+ hs-source-dirs: src-base other-modules:+ Numeric.Array.Family+ Numeric.Array.ElementWise+ Numeric.Array+ Numeric.DataFrame.SubSpace+ Numeric.DataFrame.Contraction+ Numeric.DataFrame.Mutable+ Numeric.DataFrame.Type+ Numeric.DataFrame.Inference+ Numeric.DataFrame.Shape+ Numeric.Matrix.Type+ if impl(ghcjs)+ other-modules:+ Numeric.Array.Family.ArrayT+ else+ other-modules: Numeric.Array.Family.ArrayF Numeric.Array.Family.ArrayD Numeric.Array.Family.ArrayI@@ -64,16 +86,8 @@ Numeric.Array.Family.FloatX2 Numeric.Array.Family.FloatX3 Numeric.Array.Family.FloatX4- Numeric.Array.Family- Numeric.Array.ElementWise- Numeric.Array- Numeric.DataFrame.SubSpace- Numeric.DataFrame.Contraction- Numeric.DataFrame.Mutable- Numeric.DataFrame.Type- Numeric.DataFrame.Inference- Numeric.DataFrame.Shape- Numeric.Matrix.Type+ js-sources:+ src-ghcjs/Numeric/Array/Family/ArrayT.js ghc-options: -Wall -fwarn-tabs -O2 test-suite et-test
+ src-base/Numeric/Array.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+-- Low-level implementations of data frames+--+-----------------------------------------------------------------------------++module Numeric.Array+ ( module Numeric.Array.Family+ ) where++import Numeric.Array.Family+import Numeric.Array.Family.ArrayD ()+import Numeric.Array.Family.ArrayF ()+import Numeric.Array.Family.ArrayI ()+import Numeric.Array.Family.ArrayI8 ()+import Numeric.Array.Family.ArrayI16 ()+import Numeric.Array.Family.ArrayI32 ()+import Numeric.Array.Family.ArrayI64 ()+import Numeric.Array.Family.ArrayW ()+import Numeric.Array.Family.ArrayW8 ()+import Numeric.Array.Family.ArrayW16 ()+import Numeric.Array.Family.ArrayW32 ()+import Numeric.Array.Family.ArrayW64 ()++import Numeric.Array.Family.FloatX2 ()+import Numeric.Array.Family.FloatX3 ()+import Numeric.Array.Family.FloatX4 ()
+ src-base/Numeric/Array/Family.hs view
@@ -0,0 +1,429 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE StandaloneDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family+ ( Array+ , ArrayF (..), ArrayD (..)+ , ArrayI (..), ArrayI8 (..), ArrayI16 (..), ArrayI32 (..), ArrayI64 (..)+ , ArrayW (..), ArrayW8 (..), ArrayW16 (..), ArrayW32 (..), ArrayW64 (..)+ , Scalar (..)+ , FloatX2 (..), FloatX3 (..), FloatX4 (..)+ , ArrayInstanceInference, ElemType (..), ArraySize (..)+ , ElemTypeInference (..), ArraySizeInference (..), ArrayInstanceEvidence+ , getArrayInstance, ArrayInstance (..), inferArrayInstance+ ) where+++import Data.Int (Int16, Int32, Int64, Int8)+import Data.Type.Equality ((:~:) (..))+import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Prim (ByteArray#, Double#, Float#, Int#,+ Word#, unsafeCoerce#)++import Numeric.Array.ElementWise+import Numeric.Commons+import Numeric.TypeLits+import Numeric.Dimensions++-- | Full collection of n-order arrays+type family Array t (ds :: [Nat]) = v | v -> t ds where+ Array t '[] = Scalar t+ Array Float '[2] = FloatX2+ Array Float '[3] = FloatX3+ Array Float '[4] = FloatX4+ Array Float (d ': ds) = ArrayF (d ': ds)+ Array Double (d ': ds) = ArrayD (d ': ds)+ Array Int (d ': ds) = ArrayI (d ': ds)+ Array Int8 (d ': ds) = ArrayI8 (d ': ds)+ Array Int16 (d ': ds) = ArrayI16 (d ': ds)+ Array Int32 (d ': ds) = ArrayI32 (d ': ds)+ Array Int64 (d ': ds) = ArrayI64 (d ': ds)+ Array Word (d ': ds) = ArrayW (d ': ds)+ Array Word8 (d ': ds) = ArrayW8 (d ': ds)+ Array Word16 (d ': ds) = ArrayW16 (d ': ds)+ Array Word32 (d ': ds) = ArrayW32 (d ': ds)+ Array Word64 (d ': ds) = ArrayW64 (d ': ds)+++-- | Specialize scalar type without any arrays+newtype Scalar t = Scalar { _unScalar :: t }+ deriving ( Bounded, Enum, Eq, Integral+ , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat)+instance Show t => Show (Scalar t) where+ show (Scalar t) = "{ " ++ show t ++ " }"++type instance ElemRep (Scalar t) = ElemRep t+type instance ElemPrim (Scalar Float ) = Float#+type instance ElemPrim (Scalar Double) = Double#+type instance ElemPrim (Scalar Int ) = Int#+type instance ElemPrim (Scalar Int8 ) = Int#+type instance ElemPrim (Scalar Int16 ) = Int#+type instance ElemPrim (Scalar Int32 ) = Int#+type instance ElemPrim (Scalar Int64 ) = Int#+type instance ElemPrim (Scalar Word ) = Word#+type instance ElemPrim (Scalar Word8 ) = Word#+type instance ElemPrim (Scalar Word16) = Word#+type instance ElemPrim (Scalar Word32) = Word#+type instance ElemPrim (Scalar Word64) = Word#++deriving instance PrimBytes (Scalar Float)+deriving instance PrimBytes (Scalar Double)+deriving instance PrimBytes (Scalar Int)+deriving instance PrimBytes (Scalar Int8)+deriving instance PrimBytes (Scalar Int16)+deriving instance PrimBytes (Scalar Int32)+deriving instance PrimBytes (Scalar Int64)+deriving instance PrimBytes (Scalar Word)+deriving instance PrimBytes (Scalar Word8)+deriving instance PrimBytes (Scalar Word16)+deriving instance PrimBytes (Scalar Word32)+deriving instance PrimBytes (Scalar Word64)++-- | Indexing over scalars is trivial...+instance ElementWise (Idx ('[] :: [Nat])) t (Scalar t) where+ indexOffset# x _ = _unScalar x+ (!) x _ = _unScalar x+ {-# INLINE (!) #-}+ ewmap f = Scalar . f Z . _unScalar+ {-# INLINE ewmap #-}+ ewgen f = Scalar $ f Z+ {-# INLINE ewgen #-}+ ewgenA f = Scalar <$> f Z+ {-# INLINE ewgenA #-}+ ewfoldl f x0 = f Z x0 . _unScalar+ {-# INLINE ewfoldl #-}+ ewfoldr f x0 x = f Z (_unScalar x) x0+ {-# INLINE ewfoldr #-}+ elementWise f = fmap Scalar . f . _unScalar+ {-# INLINE elementWise #-}+ indexWise f = fmap Scalar . f Z . _unScalar+ {-# INLINE indexWise #-}+ broadcast = Scalar+ {-# INLINE broadcast #-}+ update _ x _ = Scalar x+ {-# INLINE update #-}+++-- * Array implementations.+-- All array implementations have the same structure:+-- Array[Type] (element offset :: Int#) (element length :: Int#)+-- (content :: ByteArray#)+-- All types can also be instantiated with a single scalar value.+++data ArrayF (ds :: [Nat]) = ArrayF# Int# Int# ByteArray#+ | FromScalarF# Float#+data ArrayD (ds :: [Nat]) = ArrayD# Int# Int# ByteArray#+ | FromScalarD# Double#+data ArrayI (ds :: [Nat]) = ArrayI# Int# Int# ByteArray#+ | FromScalarI# Int#+data ArrayI8 (ds :: [Nat]) = ArrayI8# Int# Int# ByteArray#+ | FromScalarI8# Int#+data ArrayI16 (ds :: [Nat]) = ArrayI16# Int# Int# ByteArray#+ | FromScalarI16# Int#+data ArrayI32 (ds :: [Nat]) = ArrayI32# Int# Int# ByteArray#+ | FromScalarI32# Int#+data ArrayI64 (ds :: [Nat]) = ArrayI64# Int# Int# ByteArray#+ | FromScalarI64# Int#+data ArrayW (ds :: [Nat]) = ArrayW# Int# Int# ByteArray#+ | FromScalarW# Word#+data ArrayW8 (ds :: [Nat]) = ArrayW8# Int# Int# ByteArray#+ | FromScalarW8# Word#+data ArrayW16 (ds :: [Nat]) = ArrayW16# Int# Int# ByteArray#+ | FromScalarW16# Word#+data ArrayW32 (ds :: [Nat]) = ArrayW32# Int# Int# ByteArray#+ | FromScalarW32# Word#+data ArrayW64 (ds :: [Nat]) = ArrayW64# Int# Int# ByteArray#+ | FromScalarW64# Word#++-- * Specialized types+-- More efficient data types for small fixed-size tensors+data FloatX2 = FloatX2# Float# Float#+data FloatX3 = FloatX3# Float# Float# Float#+data FloatX4 = FloatX4# Float# Float# Float# Float#++-- * Recovering type instances at runtime+-- A combination of `ElemType t` and `ArraySize ds` should+-- define an instance of `Array t ds` unambiguously.+++-- | Keep information about the element type instance.+--+-- Warning! This part of the code is platform and flag dependent.+data ElemType t+ = t ~ Float => ETFloat+ | t ~ Double => ETDouble+ | t ~ Int => ETInt+ | t ~ Int8 => ETInt8+ | t ~ Int16 => ETInt16+ | t ~ Int32 => ETInt32+ | t ~ Int64 => ETInt64+ | t ~ Word => ETWord+ | t ~ Word8 => ETWord8+ | t ~ Word16 => ETWord16+ | t ~ Word32 => ETWord32+ | t ~ Word64 => ETWord64++-- | Keep information about the array dimensionality+--+-- Warning! This part of the code is platform and flag dependent.+data ArraySize (ds :: [Nat])+ = ds ~ '[] => ASScalar+ | ds ~ '[2] => ASX2+ | ds ~ '[3] => ASX3+ | ds ~ '[4] => ASX4+ | forall n . (ds ~ '[n], 5 <= n) => ASXN+ | forall n1 n2 ns . ds ~ (n1 ': n2 ': ns) => ASArray++-- | Keep information about the instance behind Array family+--+-- Warning! This part of the code is platform and flag dependent.+data ArrayInstance t (ds :: [Nat])+ = ( Array t ds ~ Scalar t, ds ~ '[]) => AIScalar+ | forall n ns . ( Array t ds ~ ArrayF ds, ds ~ (n ': ns), t ~ Float ) => AIArrayF+ | forall n ns . ( Array t ds ~ ArrayD ds, ds ~ (n ': ns), t ~ Double) => AIArrayD+ | forall n ns . ( Array t ds ~ ArrayI ds, ds ~ (n ': ns), t ~ Int ) => AIArrayI+ | forall n ns . ( Array t ds ~ ArrayI8 ds, ds ~ (n ': ns), t ~ Int8 ) => AIArrayI8+ | forall n ns . ( Array t ds ~ ArrayI16 ds, ds ~ (n ': ns), t ~ Int16 ) => AIArrayI16+ | forall n ns . ( Array t ds ~ ArrayI32 ds, ds ~ (n ': ns), t ~ Int32 ) => AIArrayI32+ | forall n ns . ( Array t ds ~ ArrayI64 ds, ds ~ (n ': ns), t ~ Int64 ) => AIArrayI64+ | forall n ns . ( Array t ds ~ ArrayW ds, ds ~ (n ': ns), t ~ Word ) => AIArrayW+ | forall n ns . ( Array t ds ~ ArrayW8 ds, ds ~ (n ': ns), t ~ Word8 ) => AIArrayW8+ | forall n ns . ( Array t ds ~ ArrayW16 ds, ds ~ (n ': ns), t ~ Word16) => AIArrayW16+ | forall n ns . ( Array t ds ~ ArrayW32 ds, ds ~ (n ': ns), t ~ Word32) => AIArrayW32+ | forall n ns . ( Array t ds ~ ArrayW64 ds, ds ~ (n ': ns), t ~ Word64) => AIArrayW64+ | ( Array t ds ~ FloatX2, ds ~ '[2], t ~ Float) => AIFloatX2+ | ( Array t ds ~ FloatX3, ds ~ '[3], t ~ Float) => AIFloatX3+ | ( Array t ds ~ FloatX4, ds ~ '[4], t ~ Float) => AIFloatX4++-- | A singleton type used to prove that the given Array family instance+-- has a known instance+type ArrayInstanceEvidence t (ds :: [Nat])+ = Evidence (ArrayInstanceInference t ds)+++class ElemTypeInference t where+ -- | Pattern match against result to get specific element type+ elemTypeInstance :: ElemType t++class ArraySizeInference ds where+ -- | Pattern match agains result to get actual array dimensionality+ arraySizeInstance :: ArraySize ds+ inferSnocArrayInstance :: (ElemTypeInference t, KnownDim z)+ => p t ds -> q z -> ArrayInstanceEvidence t (ds +: z)+ inferConsArrayInstance :: (ElemTypeInference t, KnownDim z)+ => q z -> p t ds -> ArrayInstanceEvidence t (z :+ ds)+ inferInitArrayInstance :: ElemTypeInference t+ => p t ds -> ArrayInstanceEvidence t (Init ds)+++-- | Use this typeclass constraint in libraries functions if there is a need+-- to select an instance of Array famility at runtime.+-- Combination of `elemTypeInstance` and `arraySizeInstance` allows+-- to bring into typechecker's scope any specific typeclass instance+type ArrayInstanceInference t ds = (ElemTypeInference t, ArraySizeInference ds)++++instance ElemTypeInference Float where+ elemTypeInstance = ETFloat+instance ElemTypeInference Double where+ elemTypeInstance = ETDouble+instance ElemTypeInference Int where+ elemTypeInstance = ETInt+instance ElemTypeInference Int8 where+ elemTypeInstance = ETInt8+instance ElemTypeInference Int16 where+ elemTypeInstance = ETInt16+instance ElemTypeInference Int32 where+ elemTypeInstance = ETInt32+instance ElemTypeInference Int64 where+ elemTypeInstance = ETInt64+instance ElemTypeInference Word where+ elemTypeInstance = ETWord+instance ElemTypeInference Word8 where+ elemTypeInstance = ETWord8+instance ElemTypeInference Word16 where+ elemTypeInstance = ETWord16+instance ElemTypeInference Word32 where+ elemTypeInstance = ETWord32+instance ElemTypeInference Word64 where+ elemTypeInstance = ETWord64++instance ArraySizeInference '[] where+ arraySizeInstance = ASScalar+ {-# INLINE arraySizeInstance #-}+ inferSnocArrayInstance _ _ = Evidence+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ inferInitArrayInstance _ = error "Init -- empty type-level list"+ {-# INLINE inferInitArrayInstance #-}++instance KnownDim d => ArraySizeInference '[d] where+ arraySizeInstance = case dimVal' @d of+ 0 -> unsafeCoerce# ASScalar+ 1 -> unsafeCoerce# ASScalar+ 2 -> unsafeCoerce# ASX2+ 3 -> unsafeCoerce# ASX3+ 4 -> unsafeCoerce# ASX4+ _ -> case (unsafeCoerce# Refl :: (5 <=? d) :~: 'True) of Refl -> ASXN+ {-# INLINE arraySizeInstance #-}+ inferSnocArrayInstance _ _ = Evidence+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ inferInitArrayInstance _ = Evidence+ {-# INLINE inferInitArrayInstance #-}++instance KnownDim d1 => ArraySizeInference '[d1, d2] where+ arraySizeInstance = ASArray+ {-# INLINE arraySizeInstance #-}+ inferSnocArrayInstance _ _ = Evidence+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ inferInitArrayInstance _ = Evidence+ {-# INLINE inferInitArrayInstance #-}+++instance ArraySizeInference (d1 ': d2 ': d3 ': ds) where+ arraySizeInstance = ASArray+ {-# INLINE arraySizeInstance #-}+ -- I know that for dimensionality > 2 all instances are the same.+ -- Hence this dirty hack should work.+ -- I have to change this when I have customized N*M instances+ inferSnocArrayInstance p q = unsafeCoerce# (inferConsArrayInstance q p)+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ -- I know that for dimensionality > 2 all instances are the same.+ -- Hence this dirty hack should work.+ -- I have to change this when I have customized N*M instances+ inferInitArrayInstance p = unsafeCoerce# (inferConsArrayInstance (Proxy @3) p)+ {-# INLINE inferInitArrayInstance #-}++++getArrayInstance :: forall t (ds :: [Nat])+ . ArrayInstanceInference t ds+ => ArrayInstance t ds+getArrayInstance = case (elemTypeInstance @t, arraySizeInstance @ds) of+ (ETFloat , ASScalar) -> AIScalar+ (ETDouble , ASScalar) -> AIScalar+ (ETInt , ASScalar) -> AIScalar+ (ETInt8 , ASScalar) -> AIScalar+ (ETInt16 , ASScalar) -> AIScalar+ (ETInt32 , ASScalar) -> AIScalar+ (ETInt64 , ASScalar) -> AIScalar+ (ETWord , ASScalar) -> AIScalar+ (ETWord8 , ASScalar) -> AIScalar+ (ETWord16 , ASScalar) -> AIScalar+ (ETWord32 , ASScalar) -> AIScalar+ (ETWord64 , ASScalar) -> AIScalar++ (ETFloat , ASX2) -> AIFloatX2+ (ETDouble , ASX2) -> AIArrayD+ (ETInt , ASX2) -> AIArrayI+ (ETInt8 , ASX2) -> AIArrayI8+ (ETInt16 , ASX2) -> AIArrayI16+ (ETInt32 , ASX2) -> AIArrayI32+ (ETInt64 , ASX2) -> AIArrayI64+ (ETWord , ASX2) -> AIArrayW+ (ETWord8 , ASX2) -> AIArrayW8+ (ETWord16 , ASX2) -> AIArrayW16+ (ETWord32 , ASX2) -> AIArrayW32+ (ETWord64 , ASX2) -> AIArrayW64++ (ETFloat , ASX3) -> AIFloatX3+ (ETDouble , ASX3) -> AIArrayD+ (ETInt , ASX3) -> AIArrayI+ (ETInt8 , ASX3) -> AIArrayI8+ (ETInt16 , ASX3) -> AIArrayI16+ (ETInt32 , ASX3) -> AIArrayI32+ (ETInt64 , ASX3) -> AIArrayI64+ (ETWord , ASX3) -> AIArrayW+ (ETWord8 , ASX3) -> AIArrayW8+ (ETWord16 , ASX3) -> AIArrayW16+ (ETWord32 , ASX3) -> AIArrayW32+ (ETWord64 , ASX3) -> AIArrayW64++ (ETFloat , ASX4) -> AIFloatX4+ (ETDouble , ASX4) -> AIArrayD+ (ETInt , ASX4) -> AIArrayI+ (ETInt8 , ASX4) -> AIArrayI8+ (ETInt16 , ASX4) -> AIArrayI16+ (ETInt32 , ASX4) -> AIArrayI32+ (ETInt64 , ASX4) -> AIArrayI64+ (ETWord , ASX4) -> AIArrayW+ (ETWord8 , ASX4) -> AIArrayW8+ (ETWord16 , ASX4) -> AIArrayW16+ (ETWord32 , ASX4) -> AIArrayW32+ (ETWord64 , ASX4) -> AIArrayW64++ (ETFloat , ASXN) -> unsafeCoerce# (AIArrayF :: ArrayInstance Float '[5])+ (ETDouble , ASXN) -> AIArrayD+ (ETInt , ASXN) -> AIArrayI+ (ETInt8 , ASXN) -> AIArrayI8+ (ETInt16 , ASXN) -> AIArrayI16+ (ETInt32 , ASXN) -> AIArrayI32+ (ETInt64 , ASXN) -> AIArrayI64+ (ETWord , ASXN) -> AIArrayW+ (ETWord8 , ASXN) -> AIArrayW8+ (ETWord16 , ASXN) -> AIArrayW16+ (ETWord32 , ASXN) -> AIArrayW32+ (ETWord64 , ASXN) -> AIArrayW64++ (ETFloat , ASArray) -> AIArrayF+ (ETDouble , ASArray) -> AIArrayD+ (ETInt , ASArray) -> AIArrayI+ (ETInt8 , ASArray) -> AIArrayI8+ (ETInt16 , ASArray) -> AIArrayI16+ (ETInt32 , ASArray) -> AIArrayI32+ (ETInt64 , ASArray) -> AIArrayI64+ (ETWord , ASArray) -> AIArrayW+ (ETWord8 , ASArray) -> AIArrayW8+ (ETWord16 , ASArray) -> AIArrayW16+ (ETWord32 , ASArray) -> AIArrayW32+ (ETWord64 , ASArray) -> AIArrayW64++-- | Given element type instance and proper dimension list,+-- infer a corresponding array instance+inferArrayInstance :: forall t ds+ . ( FiniteList ds+ , KnownDims ds+ , ElemTypeInference t+ )+ => ArrayInstanceEvidence t ds+inferArrayInstance = case tList @_ @ds of+ TLEmpty -> Evidence+ TLCons _ TLEmpty -> Evidence+ TLCons _ (TLCons _ TLEmpty) -> Evidence+ TLCons _ (TLCons _ (TLCons _ _)) -> Evidence+++_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)+_suppressHlintUnboxedTuplesWarning = undefined
+ src-base/Numeric/Array/Family/Array.h view
@@ -0,0 +1,308 @@++--------------------------------------------------------------------------------+-- * Utility functions+--------------------------------------------------------------------------------++-- | Do something in a loop for int i from 0 to n+loop1# :: Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s+loop1# n f = loop0 0#+ where+ loop0 i s | isTrue# (i ==# n) = s+ | otherwise = case f i s of s1 -> loop0 (i +# 1#) s1+{-# INLINE loop1# #-}+++-- | Do something in a loop for int i from 0 to n+loop1a# :: Int# -> (Int# -> a -> a) -> a -> a+loop1a# n f = loop0 0#+ where+ loop0 i s | isTrue# (i ==# n) = s+ | otherwise = s `seq` case f i s of s1 -> s1 `seq` loop0 (i +# 1#) s1+{-# INLINE loop1a# #-}+++-- | Treat a single number as an array+broadcastArray :: EL_TYPE_BOXED -> ARR_TYPE ds+broadcastArray (EL_CONSTR x) = ARR_FROMSCALAR x+{-# INLINE broadcastArray #-}++-- | Accumulates only idempotent operations!+-- Being applied to FromScalars, executes only once!+accumV2 :: (EL_TYPE_PRIM-> EL_TYPE_PRIM -> a -> a)+ -> ARR_TYPE ds -> ARR_TYPE ds -> a -> a+accumV2 f (ARR_FROMSCALAR a)+ (ARR_FROMSCALAR b) = f a b+accumV2 f (ARR_CONSTR offset n a)+ (ARR_FROMSCALAR b) = loop1a# n+ (\i -> f (INDEX_ARRAY a (offset +# i)) b)+accumV2 f (ARR_FROMSCALAR a)+ (ARR_CONSTR offset n b) = loop1a# n+ (\i -> f a (INDEX_ARRAY b (offset +# i)))+accumV2 f (ARR_CONSTR offsetA n a)+ (ARR_CONSTR offsetB _ b) = loop1a# n+ (\i -> f (INDEX_ARRAY a (offsetA +# i))+ (INDEX_ARRAY b (offsetB +# i))+ )++mapV :: (EL_TYPE_PRIM -> EL_TYPE_PRIM) -> ARR_TYPE ds -> ARR_TYPE ds+mapV f (ARR_FROMSCALAR x) = ARR_FROMSCALAR (f x)+mapV f (ARR_CONSTR offset n a) = case runRW#+ ( \s0 -> case newByteArray# (n *# EL_SIZE) s0 of+ (# s1, marr #) -> case loop1# n+ (\i ss -> case f (INDEX_ARRAY a (offset +# i)) of+ r -> WRITE_ARRAY marr i r ss+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> ARR_CONSTR 0# n r+{-# INLINE mapV #-}++zipV :: (EL_TYPE_PRIM -> EL_TYPE_PRIM -> EL_TYPE_PRIM)+ -> ARR_TYPE ds -> ARR_TYPE ds -> ARR_TYPE ds+zipV f (ARR_FROMSCALAR a)+ (ARR_FROMSCALAR b) = ARR_FROMSCALAR (f a b)+zipV f x (ARR_FROMSCALAR b) = mapV (`f` b) x+zipV f (ARR_FROMSCALAR a) y = mapV (f a) y+zipV f (ARR_CONSTR offsetA n a)+ (ARR_CONSTR offsetB _ b) = case runRW#+ ( \s0 -> case newByteArray# (n *# EL_SIZE ) s0 of+ (# s1, marr #) -> case loop1# n+ (\i ss -> case f (INDEX_ARRAY a (offsetA +# i))+ (INDEX_ARRAY b (offsetB +# i)) of+ r -> WRITE_ARRAY marr i r ss+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> ARR_CONSTR 0# n r+{-# INLINE zipV #-}++++--------------------------------------------------------------------------------+-- * Instances+--------------------------------------------------------------------------------+++++wr :: ARR_TYPE (ds :: [Nat]) -> Int# -> Int#+ -> (MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld)+ -> ARR_TYPE ds+wr _ bs n ff = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case ff marr s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> ARR_CONSTR 0# n r+{-# INLINE wr #-}++data ArrayUpdate# (f :: * -> *) s+ = AU# Int# !(f (MutableByteArray# s -> State# s -> State# s))++instance Dimensions ds => ElementWise (Idx ds) EL_TYPE_BOXED (ARR_TYPE (ds :: [Nat])) where+ indexOffset# (ARR_CONSTR off _ a) j = EL_CONSTR (INDEX_ARRAY a (off +# j))+ indexOffset# (ARR_FROMSCALAR x) _ = EL_CONSTR x+ {-# INLINE indexOffset# #-}+ (!) (ARR_CONSTR off _ a) i+ = case fromEnum i of I# j -> EL_CONSTR (INDEX_ARRAY a (off +# j))+ (!) (ARR_FROMSCALAR x) _ = EL_CONSTR x+ {-# INLINE (!) #-}++ broadcast (EL_CONSTR x) = ARR_FROMSCALAR x+ {-# INLINE broadcast #-}++ ewmap f x@(ARR_CONSTR offset n arr) = case runRW#+ (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of+ (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off s -> case f ii (EL_CONSTR (INDEX_ARRAY arr (offset +# off))) of+ (EL_CONSTR r) -> WRITE_ARRAY marr off r s+ ) 0# 1# s1 of+ s3 -> unsafeFreezeByteArray# marr s3+ ) of (# _, r #) -> ARR_CONSTR 0# n r+ ewmap f x@(ARR_FROMSCALAR scalVal) = case runRW#+ (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of+ (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off s -> case f ii (EL_CONSTR scalVal) of+ (EL_CONSTR r) -> WRITE_ARRAY marr off r s+ ) 0# 1# s1 of+ s3 -> unsafeFreezeByteArray# marr s3+ ) of (# _, r #) -> ARR_CONSTR 0# n r+ where+ n = case totalDim x of I# d -> d+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of+ (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off s -> case f ii of+ (EL_CONSTR r) -> WRITE_ARRAY marr off r s+ ) 0# 1# s1 of+ s3 -> unsafeFreezeByteArray# marr s3+ ) of (# _, r #) -> ARR_CONSTR 0# n r+ where+ x = undefined :: ARR_TYPE ds+ n = case totalDim x of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f+ = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of+ AU# _ ff -> wr x bs n <$> ff+ where+ g ds (AU# i ff) = AU# ( i +# 1# )+ $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+ <$> f ds <*> ff+ x = undefined :: ARR_TYPE ds+ n = case totalDim x of I# d -> d+ bs = n *# EL_SIZE++ ewfoldr f v0 x@(ARR_CONSTR offset _ arr)+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off -> f ii (EL_CONSTR (INDEX_ARRAY arr off))) offset 1# v0+ ewfoldr f v0 x@(ARR_FROMSCALAR scalVal) = foldDimReverseIdx (dim `inSpaceOf` x)+ (\ii -> f ii (EL_CONSTR scalVal)) v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x@(ARR_CONSTR offset _ arr)+ = foldDim (dim `inSpaceOf` x)+ (\ii off v -> f ii v (EL_CONSTR (INDEX_ARRAY arr off))) offset 1# v0+ ewfoldl f v0 x@(ARR_FROMSCALAR scalVal) = foldDimIdx (dim `inSpaceOf` x)+ (\ii v -> f ii v (EL_CONSTR scalVal)) v0+ {-# INLINE ewfoldl #-}++ indexWise f x@(ARR_CONSTR offset n arr)+ = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of+ AU# _ ff -> wr x bs n <$> ff+ where+ g ds (AU# i ff) = AU# ( i +# 1# )+ $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+ <$> f ds (EL_CONSTR (INDEX_ARRAY arr (offset +# i))) <*> ff+ bs = n *# EL_SIZE++ indexWise f x@(ARR_FROMSCALAR scalVal)+ = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of+ AU# _ ff -> wr x bs n <$> ff+ where+ n = case totalDim x of I# d -> d+ g ds (AU# i ff) = AU# ( i +# 1# )+ $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+ <$> f ds (EL_CONSTR scalVal) <*> ff+ bs = n *# EL_SIZE+++ elementWise f x@(ARR_CONSTR offset n arr) =+ wr x bs n <$> loop1a# n g (pure (\_ s -> s))+ where+ g i ff = (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+ <$> f (EL_CONSTR (INDEX_ARRAY arr (offset +# i))) <*> ff+ bs = n *# EL_SIZE+ elementWise f x@(ARR_FROMSCALAR scalVal) =+ wr x bs n <$> loop1a# n g (pure (\_ s -> s))+ where+ fa = f (EL_CONSTR scalVal)+ n = case totalDim x of I# d -> d+ g i ff = (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))+ <$> fa <*> ff+ bs = n *# EL_SIZE++ update ei (EL_CONSTR y) (ARR_CONSTR off len arr)+ | I# i <- fromEnum ei+ = case runRW#+ ( \s0 -> case newByteArray# ( len *# EL_SIZE ) s0 of+ (# s1, marr #) -> case copyByteArray# arr (off *# EL_SIZE) marr 0# (len *# EL_SIZE) s1 of+ s2 -> case WRITE_ARRAY marr i y s2 of+ s3 -> unsafeFreezeByteArray# marr s3+ ) of (# _, r #) -> ARR_CONSTR 0# len r+++ update ei (EL_CONSTR y) x@(ARR_FROMSCALAR scalVal)+ | I# i <- fromEnum ei+ , I# len <- totalDim x+ = case runRW#+ ( \s0 -> case newByteArray# ( len *# EL_SIZE ) s0 of+ (# s1, marr #) -> case loop1# len (\j -> WRITE_ARRAY marr j scalVal) s1 of+ s2 -> case WRITE_ARRAY marr i y s2 of+ s3 -> unsafeFreezeByteArray# marr s3+ ) of (# _, r #) -> ARR_CONSTR 0# len r++instance Dimensions ds+ => Show (ARR_TYPE (ds :: [Nat])) where+ show x = case dim @ds of+ D -> "{ " ++ show (x ! Z) ++ " }"+ Dn :* D -> ('{' :) . drop 1 $+ foldr (\i s -> ", " ++ show (x ! i) ++ s) " }"+ [minBound .. maxBound]+ (Dn :: Dim (n :: Nat)) :* (Dn :: Dim (m :: Nat)) :* (_ :: Dim (dss :: [Nat])) ->+ case inferDropNDimensions @2 @ds of+ Evidence ->+ let loopInner :: Idx dss -> Idx '[n,m] -> String+ loopInner ods (n:!m:!_) = ('{' :) . drop 2 $+ foldr (\i ss -> '\n':+ foldr (\j s ->+ ", " ++ show (x ! (i :! j :! ods)) ++ s+ ) ss [1..m]+ ) " }" [1..n]+ loopOuter :: Idx dss -> String -> String+ loopOuter Z s = "\n" ++ loopInner Z maxBound ++ s+ loopOuter ds s = "\n(i j" ++ drop 3 (show ds) ++ "):\n"+ ++ loopInner ds maxBound ++ s+ in drop 1 $ foldr loopOuter "" [minBound..maxBound]++instance Eq (ARR_TYPE ds) where+ a == b = accumV2 (\x y r -> r && isTrue# (OP_EQ x y)) a b True+ {-# INLINE (==) #-}+ a /= b = accumV2 (\x y r -> r || isTrue# (OP_NE x y)) a b False+ {-# INLINE (/=) #-}+++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+-- and lexicographical ordering for `compare`+instance Ord (ARR_TYPE ds) where+ a > b = accumV2 (\x y r -> r && isTrue# (OP_GT x y)) a b True+ {-# INLINE (>) #-}+ a < b = accumV2 (\x y r -> r && isTrue# (OP_LT x y)) a b True+ {-# INLINE (<) #-}+ a >= b = accumV2 (\x y r -> r && isTrue# (OP_GE x y)) a b True+ {-# INLINE (>=) #-}+ a <= b = accumV2 (\x y r -> r && isTrue# (OP_LE x y)) a b True+ {-# INLINE (<=) #-}+ -- | Compare lexicographically+ compare a b = accumV2 (\x y r -> r `mappend`+ if isTrue# (OP_GT x y)+ then GT+ else if isTrue# (OP_LT x y)+ then LT+ else EQ+ ) a b EQ+ {-# INLINE compare #-}+ -- | Element-wise minimum+ min = zipV (\x y -> if isTrue# (OP_GT x y) then y else x)+ {-# INLINE min #-}+ -- | Element-wise maximum+ max = zipV (\x y -> if isTrue# (OP_GT x y) then x else y)+ {-# INLINE max #-}+++type instance ElemRep (ARR_TYPE ds) = EL_RUNTIME_REP+type instance ElemPrim (ARR_TYPE ds) = EL_TYPE_PRIM+instance Dimensions ds => PrimBytes (ARR_TYPE ds) where+ toBytes (ARR_CONSTR off size a) = (# off, size, a #)+ toBytes (ARR_FROMSCALAR x) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop1# n+ (\i -> WRITE_ARRAY marr i x+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> (# 0#, n, r #)+ where+ n = case totalDim (undefined :: ArrayF ds) of I# d -> d+ bs = n *# EL_SIZE+ {-# INLINE toBytes #-}+ fromBytes (# off, size, a #) = ARR_CONSTR off size a+ {-# INLINE fromBytes #-}+ byteSize x = case totalDim x of+ I# d -> EL_SIZE *# d+ {-# INLINE byteSize #-}+ byteAlign _ = EL_ALIGNMENT+ {-# INLINE byteAlign #-}+ elementByteSize _ = EL_SIZE+ {-# INLINE elementByteSize #-}+ ix i (ARR_CONSTR off _ a) = INDEX_ARRAY a (off +# i)+ ix _ (ARR_FROMSCALAR x) = x+ {-# INLINE ix #-}
+ src-base/Numeric/Array/Family/ArrayD.hs view
@@ -0,0 +1,408 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayD+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayD () where+++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Double (..), Int (..),+ RuntimeRep (..), isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.DataFrame.Type+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+import Numeric.TypeLits+import Numeric.Matrix.Type+++#include "MachDeps.h"+#define ARR_TYPE ArrayD+#define ARR_FROMSCALAR FromScalarD#+#define ARR_CONSTR ArrayD#+#define EL_TYPE_BOXED Double+#define EL_TYPE_PRIM Double#+#define EL_RUNTIME_REP 'DoubleRep+#define EL_CONSTR D#+#define EL_SIZE SIZEOF_HSDOUBLE#+#define EL_ALIGNMENT ALIGNMENT_HSDOUBLE#+#define EL_ZERO 0.0##+#define EL_ONE 1.0##+#define EL_MINUS_ONE -1.0##+#define INDEX_ARRAY indexDoubleArray#+#define WRITE_ARRAY writeDoubleArray#+#define OP_EQ (==##)+#define OP_NE (/=##)+#define OP_GT (>##)+#define OP_GE (>=##)+#define OP_LT (<##)+#define OP_LE (<=##)+#define OP_PLUS (+##)+#define OP_MINUS (-##)+#define OP_TIMES (*##)+#define OP_NEGATE negateDouble#+#include "Array.h"+++instance Num (ArrayD ds) where+ (+) = zipV (+##)+ {-# INLINE (+) #-}+ (-) = zipV (-##)+ {-# INLINE (-) #-}+ (*) = zipV (*##)+ {-# INLINE (*) #-}+ negate = mapV negateDouble#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (x >=## 0.0##)+ then x+ else negateDouble# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (x >## 0.0##)+ then 1.0##+ else if isTrue# (x <## 0.0##)+ then -1.0##+ else 0.0##+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional (ArrayD ds) where+ (/) = zipV (/##)+ {-# INLINE (/) #-}+ recip = mapV (1.0## /##)+ {-# INLINE recip #-}+ fromRational = broadcastArray . fromRational+ {-# INLINE fromRational #-}+++instance Floating (ArrayD ds) where+ pi = broadcastArray pi+ {-# INLINE pi #-}+ exp = mapV expDouble#+ {-# INLINE exp #-}+ log = mapV logDouble#+ {-# INLINE log #-}+ sqrt = mapV sqrtDouble#+ {-# INLINE sqrt #-}+ sin = mapV sinDouble#+ {-# INLINE sin #-}+ cos = mapV cosDouble#+ {-# INLINE cos #-}+ tan = mapV tanDouble#+ {-# INLINE tan #-}+ asin = mapV asinDouble#+ {-# INLINE asin #-}+ acos = mapV acosDouble#+ {-# INLINE acos #-}+ atan = mapV atanDouble#+ {-# INLINE atan #-}+ sinh = mapV sinDouble#+ {-# INLINE sinh #-}+ cosh = mapV coshDouble#+ {-# INLINE cosh #-}+ tanh = mapV tanhDouble#+ {-# INLINE tanh #-}+ (**) = zipV (**##)+ {-# INLINE (**) #-}++ logBase = zipV (\x y -> logDouble# y /## logDouble# x)+ {-# INLINE logBase #-}+ asinh = mapV (\x -> logDouble# (x +##+ sqrtDouble# (1.0## +## x *## x)))+ {-# INLINE asinh #-}+ acosh = mapV (\x -> case x +## 1.0## of+ y -> logDouble# ( x +## y *##+ sqrtDouble# ((x -## 1.0##) /## y)+ )+ )+ {-# INLINE acosh #-}+ atanh = mapV (\x -> 0.5## *##+ logDouble# ((1.0## +## x) /## (1.0## -## x)))+ {-# INLINE atanh #-}+++instance (KnownNat n, KnownNat m, ArrayD '[n,m] ~ Array Double '[n,m], 2 <= n, 2 <= m)+ => MatrixCalculus Double n m where+ transpose (KnownDataFrame (ArrayD# offs nm arr)) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop2# n m+ (\i j s' -> writeDoubleArray# marr (j +# m *# i)+ (indexDoubleArray# arr (offs +# j *# n +# i)) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, nm, r #)+ where+ n = case fromInteger $ natVal (Proxy @n) of I# np -> np+ m = case fromInteger $ natVal (Proxy @m) of I# mp -> mp+ bs = n *# m *# EL_SIZE+ transpose (KnownDataFrame (FromScalarD# x)) = unsafeCoerce# $ FromScalarD# x++instance ( KnownDim n, ArrayD '[n,n] ~ Array Double '[n,n] )+ => SquareMatrixCalculus Double n where+ eye = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop1# n+ (\j s' -> writeDoubleArray# marr (j *# n1) 1.0## s'+ ) (setByteArray# marr 0# bs 0# s1) of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)+ where+ n1 = n +# 1#+ n = case dimVal' @n of I# np -> np+ bs = n *# n *# EL_SIZE+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar (D# v))) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop1# n+ (\j s' -> writeDoubleArray# marr (j *# n1) v s'+ ) (setByteArray# marr 0# bs 0# s1) of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)+ where+ n1 = n +# 1#+ n = case dimVal' @n of I# np -> np+ bs = n *# n *# EL_SIZE+ {-# INLINE diag #-}+++ det (KnownDataFrame (ArrayD# off nsqr arr)) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, mat #) -> case newByteArray#+ (n *# EL_SIZE)+ (copyByteArray# arr offb mat 0# bs s1) of+ (# s2, vec #) ->+ let f i x s | isTrue# (i >=# n) = (# s, x #)+ | otherwise =+ let !(# s' , j #) = maxInRowRem# n n i mat s+ !(# s'', x' #) = if isTrue# (i /=# j)+ then (# swapCols# n i j vec mat s'+ , negateDouble# x #)+ else (# s', x #)+ !(# s''', y #) = clearRowEnd# n n i mat s''+ in if isTrue# (0.0## ==## y)+ then (# s''', 0.0## #)+ else f (i +# 1#) (x' *## y) s'''+ in f 0# 1.0## s2+ ) of (# _, r #) -> KnownDataFrame (Scalar (D# r))+ where+ n = case dimVal' @n of I# np -> np+ offb = off *# EL_SIZE+ bs = nsqr *# EL_SIZE+ det (KnownDataFrame (FromScalarD# _)) = 0+ {-# INLINE det #-}++++ trace (KnownDataFrame (ArrayD# off nsqr a)) = KnownDataFrame (Scalar (D# (loop' 0# 0.0##)))+ where+ n1 = n +# 1#+ n = case dimVal' @n of I# np -> np+ loop' i acc | isTrue# (i ># nsqr) = acc+ | otherwise = loop' (i +# n1)+ (indexDoubleArray# a (off +# i) +## acc)+ trace (KnownDataFrame (FromScalarD# x)) = KnownDataFrame (Scalar (D# (x *## n)))+ where+ n = case fromIntegral (dimVal' @n) of D# np -> np+ {-# INLINE trace #-}++++instance (KnownNat n, ArrayD '[n,n] ~ Array Double '[n,n], 2 <= n) => MatrixInverse Double n where+ inverse (KnownDataFrame (ArrayD# offs nsqr arr)) = case runRW#+ ( \s0 -> case newByteArray# (bs *# 2#) s0 of+ (# s1, mat #) -> case newByteArray# (vs *# 2#)+ -- copy original matrix to the top of an augmented matrix+ (loop1# n (\i s -> writeDoubleArray# mat+ (i *# nn +# i +# n) 1.0##+ (copyByteArray# arr (offb +# i *# vs)+ mat (2# *# i *# vs) vs s))+ (setByteArray# mat 0# (bs *# 2#) 0# s1)+ ) of+ (# s2, vec #) ->+ let f i s | isTrue# (i >=# n) = s+ | otherwise =+ let !(# s' , j #) = maxInRowRem# nn n i mat s+ s'' = if isTrue# (i /=# j) then swapCols# nn i j vec mat s'+ else s'+ !(# s''', _ #) = clearRowAll# nn n i mat s''+ in f (i +# 1#) s'''+ in unsafeFreezeByteArray# mat+ ( shrinkMutableByteArray# mat bs+ (-- copy inverse matrix from the augmented part+ loop1# n (\i s ->+ copyMutableByteArray# mat+ (2# *# i *# vs +# vs)+ mat (i *# vs) vs s)+ (f 0# s2)+ )+ )+ ) of (# _, r #) -> KnownDataFrame (ArrayD# 0# nsqr r)+ where+ nn = 2# *# n+ n = case fromInteger $ natVal (Proxy @n) of I# np -> np+ vs = n *# EL_SIZE+ bs = n *# n *# EL_SIZE+ offb = offs *# EL_SIZE+ inverse (KnownDataFrame (FromScalarD# _)) = error "Cannot take inverse of a degenerate matrix"+++-----------------------------------------------------------------------------+-- Helpers+-----------------------------------------------------------------------------++-- #ifndef UNSAFE_INDICES+-- | isTrue# ( (i ># dim# _x)+-- `orI#` (i <=# 0#)+-- ) = error $ "Bad index " +++-- show (I# i) ++ " for " ++ show (dim _x) ++ "D vector"+-- | otherwise+-- #endif+++-- | Swap columns i and j. Does not check if i or j is larger than matrix width m+swapCols# :: Int# -- n+ -> Int# -- ith column to swap+ -> Int# -- jth column to swap+ -> MutableByteArray# s -- buffer byte array of length of n elems+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> State# s -- next state+swapCols# n i j vec mat s0 =+ -- copy ith column to bugger vec+ case copyMutableByteArray# mat (i *# bs) vec 0# bs s0 of+ s1 -> case copyMutableByteArray# mat (j *# bs) mat (i *# bs) bs s1 of+ s2 -> copyMutableByteArray# vec 0# mat (j *# bs) bs s2+ where+ bs = n *# EL_SIZE++-- | Starting from i-th row and i+1-th column, substract a multiple of i-th column from i+1 .. m columns,+-- such that there are only zeroes in i-th row and i+1..m columns elements.+clearRowEnd# :: Int# -- n+ -> Int# -- m+ -> Int# -- ith column to remove from all others+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> (# State# s, Double# #) -- next state and a diagonal element+clearRowEnd# n m i mat s0 = (# loop' (i +# 1#) s1, y' #)+ where+ y0 = (n +# 1#) *# i +# 1# -- first element in source column+ !(# s1, y' #) = readDoubleArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+ yrc = 1.0## /## y'+ n' = n -# i -# 1#+ loop' k s | isTrue# (k >=# m) = s+ | otherwise = loop' (k +# 1#)+ ( let x0 = k *# n +# i+ !(# s', a' #) = readDoubleArray# mat x0 s+ s'' = writeDoubleArray# mat x0 0.0## s'+ a = a' *## yrc+ in multNRem# n' (x0 +# 1#) y0 a mat s''+ )++-- | Substract a multiple of i-th column from 0 .. i-1 and i+1 .. m columns,+-- such that there are only zeroes in i-th row everywhere except i-th column+-- Assuming that elements in 0..i-1 columnts and in i-th row are zeroes, so they do not affect other columns.+-- After all columns updated, divide i-th row by its diagonal element, so (i,i) element has 1.+clearRowAll# :: Int# -- n+ -> Int# -- m+ -> Int# -- ith column to remove from all others+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> (# State# s, Double# #) -- next state and a diagonal element+clearRowAll# n m i mat s0 = (# divLoop (i +# 1#)+ (writeDoubleArray# mat ((n +# 1#) *# i) 1.0##+ (loop' 0# i (loop' (i +# 1#) m s1))), y' #)+ where+ y0 = (n +# 1#) *# i +# 1# -- first element in source column+ !(# s1, y' #) = readDoubleArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+ yrc = 1.0## /## y'+ n' = n -# i -# 1#+ loop' k km s | isTrue# (k >=# km) = s+ | otherwise = loop' (k +# 1#) km+ ( let x0 = k *# n +# i+ !(# s', a' #) = readDoubleArray# mat x0 s+ s'' = writeDoubleArray# mat x0 0.0## s'+ a = a' *## yrc+ in multNRem# n' (x0 +# 1#) y0 a mat s''+ )+ divLoop k s | isTrue# (k >=# n) = s+ | otherwise = divLoop (k +# 1#)+ ( let x0 = n *# i +# k+ !(# s', x #) = readDoubleArray# mat x0 s+ in writeDoubleArray# mat x0 (x *## yrc) s'+ )+++-- | Remove a multiple of one row from another one.+-- do: xi = xi - yi*a+multNRem# :: Int# -- n - nr of elements to go through+ -> Int# -- start idx of x (update)+ -> Int# -- start idx of y (read)+ -> Double# -- multiplier a+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> State# s -- next state+multNRem# 0# _ _ _ _ s = s+multNRem# n x0 y0 a mat s = multNRem# (n -# 1#) (x0 +# 1#) (y0 +# 1#) a mat+ ( case readDoubleArray# mat y0 s of+ (# s1, y #) -> case readDoubleArray# mat x0 s1 of+ (# s2, x #) -> writeDoubleArray# mat x0 (x -## y *## a) s2+ )++++-- | Gives index of maximum (absolute) element in i-th row, starting from i-th element only.+-- If i >= m then returns i.+maxInRowRem# :: Int# -- n+ -> Int# -- m+ -> Int# -- ith column to start to search for and a row to look in+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> (# State# s, Int# #) -- next state+maxInRowRem# n m i mat s0 = loop' i (abs# v) i s1+ where+ !(# s1, v #) = readDoubleArray# mat ((n +# 1#) *# i) s0+ abs# x = if isTrue# (x >=## 0.0##) then x else negateDouble# x+ loop' ok ov k s | isTrue# (k >=# m) = (# s, ok #)+ | otherwise = case readDoubleArray# mat (n *# k +# i) s of+ (# s', v' #) -> if isTrue# (abs# v' >## ov)+ then loop' k (abs# v') (k +# 1#) s'+ else loop' ok ov (k +# 1#) s'++-- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1+loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s)+ -> State# s -> State# s+loop2# n m f = loop0 0# 0#+ where+ loop0 i j s | isTrue# (j ==# m) = s+ | isTrue# (i ==# n) = loop0 0# (j +# 1#) s+ | otherwise = case f i j s of s1 -> loop0 (i +# 1#) j s1+{-# INLINE loop2# #-}
+ src-base/Numeric/Array/Family/ArrayF.hs view
@@ -0,0 +1,412 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayF+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayF () where++++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Float (..), Int (..),+ RuntimeRep (..), isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.DataFrame.Type+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+import Numeric.TypeLits+import Numeric.Matrix.Type++#include "MachDeps.h"+#define ARR_TYPE ArrayF+#define ARR_FROMSCALAR FromScalarF#+#define ARR_CONSTR ArrayF#+#define EL_TYPE_BOXED Float+#define EL_TYPE_PRIM Float#+#define EL_RUNTIME_REP 'FloatRep+#define EL_CONSTR F#+#define EL_SIZE SIZEOF_HSFLOAT#+#define EL_ALIGNMENT ALIGNMENT_HSFLOAT#+#define EL_ZERO 0.0#+#define EL_ONE 1.0#+#define EL_MINUS_ONE -1.0#+#define INDEX_ARRAY indexFloatArray#+#define WRITE_ARRAY writeFloatArray#+#define OP_EQ eqFloat#+#define OP_NE neFloat#+#define OP_GT gtFloat#+#define OP_GE geFloat#+#define OP_LT ltFloat#+#define OP_LE leFloat#+#define OP_PLUS plusFloat#+#define OP_MINUS minusFloat#+#define OP_TIMES timesFloat#+#define OP_NEGATE negateFloat#+#include "Array.h"+++instance Num (ArrayF ds) where+ (+) = zipV plusFloat#+ {-# INLINE (+) #-}+ (-) = zipV minusFloat#+ {-# INLINE (-) #-}+ (*) = zipV timesFloat#+ {-# INLINE (*) #-}+ negate = mapV negateFloat#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (geFloat# x 0.0#)+ then x+ else negateFloat# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (gtFloat# x 0.0#)+ then 1.0#+ else if isTrue# (ltFloat# x 0.0#)+ then -1.0#+ else 0.0#+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional (ArrayF ds) where+ (/) = zipV divideFloat#+ {-# INLINE (/) #-}+ recip = mapV (divideFloat# 1.0#)+ {-# INLINE recip #-}+ fromRational = broadcastArray . fromRational+ {-# INLINE fromRational #-}++++instance Floating (ArrayF ds) where+ pi = broadcastArray pi+ {-# INLINE pi #-}+ exp = mapV expFloat#+ {-# INLINE exp #-}+ log = mapV logFloat#+ {-# INLINE log #-}+ sqrt = mapV sqrtFloat#+ {-# INLINE sqrt #-}+ sin = mapV sinFloat#+ {-# INLINE sin #-}+ cos = mapV cosFloat#+ {-# INLINE cos #-}+ tan = mapV tanFloat#+ {-# INLINE tan #-}+ asin = mapV asinFloat#+ {-# INLINE asin #-}+ acos = mapV acosFloat#+ {-# INLINE acos #-}+ atan = mapV atanFloat#+ {-# INLINE atan #-}+ sinh = mapV sinFloat#+ {-# INLINE sinh #-}+ cosh = mapV coshFloat#+ {-# INLINE cosh #-}+ tanh = mapV tanhFloat#+ {-# INLINE tanh #-}+ (**) = zipV powerFloat#+ {-# INLINE (**) #-}++ logBase = zipV (\x y -> logFloat# y `divideFloat#` logFloat# x)+ {-# INLINE logBase #-}+ asinh = mapV (\x -> logFloat# (x `plusFloat#`+ sqrtFloat# (1.0# `plusFloat#` timesFloat# x x)))+ {-# INLINE asinh #-}+ acosh = mapV (\x -> case plusFloat# x 1.0# of+ y -> logFloat# ( x `plusFloat#` timesFloat# y+ (sqrtFloat# (minusFloat# x 1.0# `divideFloat#` y))+ )+ )+ {-# INLINE acosh #-}+ atanh = mapV (\x -> 0.5# `timesFloat#`+ logFloat# (plusFloat# 1.0# x `divideFloat#` minusFloat# 1.0# x))+ {-# INLINE atanh #-}+++++instance (KnownDim n, KnownDim m, ArrayF '[n,m] ~ Array Float '[n,m], 2 <= n, 2 <= m)+ => MatrixCalculus Float n m where+ transpose (KnownDataFrame (ArrayF# offs nm arr)) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop2# n m+ (\i j s' -> writeFloatArray# marr (j +# m *# i)+ (indexFloatArray# arr (offs +# j *# n +# i)) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, nm, r #)+ where+ n = case dimVal' @n of I# np -> np+ m = case dimVal' @m of I# mp -> mp+ bs = n *# m *# SIZEOF_HSFLOAT#+ transpose (KnownDataFrame (FromScalarF# x)) = unsafeCoerce# $ FromScalarF# x++instance ( KnownDim n, ArrayF '[n,n] ~ Array Float '[n,n] )+ => SquareMatrixCalculus Float n where+ eye = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop1# n+ (\j s' -> writeFloatArray# marr (j *# n1) 1.0# s'+ ) (setByteArray# marr 0# bs 0# s1) of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)+ where+ n1 = n +# 1#+ n = case dimVal' @n of I# np -> np+ bs = n *# n *# SIZEOF_HSFLOAT#+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar (F# v))) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) -> case loop1# n+ (\j s' -> writeFloatArray# marr (j *# n1) v s'+ ) (setByteArray# marr 0# bs 0# s1) of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)+ where+ n1 = n +# 1#+ n = case dimVal' @n of I# np -> np+ bs = n *# n *# SIZEOF_HSFLOAT#+ {-# INLINE diag #-}+++ det (KnownDataFrame (ArrayF# off nsqr arr)) = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, mat #) -> case newByteArray#+ (n *# SIZEOF_HSFLOAT#)+ (copyByteArray# arr offb mat 0# bs s1) of+ (# s2, vec #) ->+ let f i x s | isTrue# (i >=# n) = (# s, x #)+ | otherwise =+ let !(# s' , j #) = maxInRowRem# n n i mat s+ !(# s'', x' #) = if isTrue# (i /=# j)+ then (# swapCols# n i j vec mat s'+ , negateFloat# x #)+ else (# s', x #)+ !(# s''', y #) = clearRowEnd# n n i mat s''+ in if isTrue# (eqFloat# 0.0# y)+ then (# s''', 0.0# #)+ else f (i +# 1#) (timesFloat# x' y) s'''+ in f 0# 1.0# s2+ ) of (# _, r #) -> KnownDataFrame (Scalar (F# r))+ where+ n = case dimVal' @n of I# np -> np+ offb = off *# SIZEOF_HSFLOAT#+ bs = nsqr *# SIZEOF_HSFLOAT#+ det (KnownDataFrame (FromScalarF# _)) = 0+ {-# INLINE det #-}++++ trace (KnownDataFrame (ArrayF# off nsqr a)) = KnownDataFrame (Scalar (F# (loop' 0# 0.0#)))+ where+ n1 = n +# 1#+ n = case dimVal' @n of I# np -> np+ loop' i acc | isTrue# (i ># nsqr) = acc+ | otherwise = loop' (i +# n1)+ (indexFloatArray# a (off +# i) `plusFloat#` acc)+ trace (KnownDataFrame (FromScalarF# x)) = KnownDataFrame (Scalar (F# (x `timesFloat#` n)))+ where+ n = case fromIntegral (dimVal' @n) of F# np -> np+ {-# INLINE trace #-}++++instance (KnownNat n, ArrayF '[n,n] ~ Array Float '[n,n], 2 <= n) => MatrixInverse Float n where+ inverse (KnownDataFrame (ArrayF# offs nsqr arr)) = case runRW#+ ( \s0 -> case newByteArray# (bs *# 2#) s0 of+ (# s1, mat #) -> case newByteArray# (vs *# 2#)+ -- copy original matrix to the top of an augmented matrix+ (loop1# n (\i s -> writeFloatArray# mat+ (i *# nn +# i +# n) 1.0#+ (copyByteArray# arr (offb +# i *# vs)+ mat (2# *# i *# vs) vs s))+ (setByteArray# mat 0# (bs *# 2#) 0# s1)+ ) of+ (# s2, vec #) ->+ let f i s | isTrue# (i >=# n) = s+ | otherwise =+ let !(# s' , j #) = maxInRowRem# nn n i mat s+ s'' = if isTrue# (i /=# j) then swapCols# nn i j vec mat s'+ else s'+ !(# s''', _ #) = clearRowAll# nn n i mat s''+ in f (i +# 1#) s'''+ in unsafeFreezeByteArray# mat+ ( shrinkMutableByteArray# mat bs+ (-- copy inverse matrix from the augmented part+ loop1# n (\i s ->+ copyMutableByteArray# mat+ (2# *# i *# vs +# vs)+ mat (i *# vs) vs s)+ (f 0# s2)+ )+ )+ ) of (# _, r #) -> KnownDataFrame (ArrayF# 0# nsqr r)+ where+ nn = 2# *# n+ n = case dimVal' @n of I# np -> np+ vs = n *# SIZEOF_HSFLOAT#+ bs = n *# n *# SIZEOF_HSFLOAT#+ offb = offs *# SIZEOF_HSFLOAT#+ inverse (KnownDataFrame (FromScalarF# _)) = error "Cannot take inverse of a degenerate matrix"+++-----------------------------------------------------------------------------+-- Helpers+-----------------------------------------------------------------------------++-- #ifndef UNSAFE_INDICES+-- | isTrue# ( (i ># dim# _x)+-- `orI#` (i <=# 0#)+-- ) = error $ "Bad index " +++-- show (I# i) ++ " for " ++ show (dim _x) ++ "D vector"+-- | otherwise+-- #endif+++-- | Swap columns i and j. Does not check if i or j is larger than matrix width m+swapCols# :: Int# -- n+ -> Int# -- ith column to swap+ -> Int# -- jth column to swap+ -> MutableByteArray# s -- buffer byte array of length of n elems+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> State# s -- next state+swapCols# n i j vec mat s0 =+ -- copy ith column to bugger vec+ case copyMutableByteArray# mat (i *# bs) vec 0# bs s0 of+ s1 -> case copyMutableByteArray# mat (j *# bs) mat (i *# bs) bs s1 of+ s2 -> copyMutableByteArray# vec 0# mat (j *# bs) bs s2+ where+ bs = n *# SIZEOF_HSFLOAT#++-- | Starting from i-th row and i+1-th column, substract a multiple of i-th column from i+1 .. m columns,+-- such that there are only zeroes in i-th row and i+1..m columns elements.+clearRowEnd# :: Int# -- n+ -> Int# -- m+ -> Int# -- ith column to remove from all others+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> (# State# s, Float# #) -- next state and a diagonal element+clearRowEnd# n m i mat s0 = (# loop' (i +# 1#) s1, y' #)+ where+ y0 = (n +# 1#) *# i +# 1# -- first element in source column+ !(# s1, y' #) = readFloatArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+ yrc = 1.0# `divideFloat#` y'+ n' = n -# i -# 1#+ loop' k s | isTrue# (k >=# m) = s+ | otherwise = loop' (k +# 1#)+ ( let x0 = k *# n +# i+ !(# s', a' #) = readFloatArray# mat x0 s+ s'' = writeFloatArray# mat x0 0.0# s'+ a = a' `timesFloat#` yrc+ in multNRem# n' (x0 +# 1#) y0 a mat s''+ )++-- | Substract a multiple of i-th column from 0 .. i-1 and i+1 .. m columns,+-- such that there are only zeroes in i-th row everywhere except i-th column+-- Assuming that elements in 0..i-1 columnts and in i-th row are zeroes, so they do not affect other columns.+-- After all columns updated, divide i-th row by its diagonal element, so (i,i) element has 1.+clearRowAll# :: Int# -- n+ -> Int# -- m+ -> Int# -- ith column to remove from all others+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> (# State# s, Float# #) -- next state and a diagonal element+clearRowAll# n m i mat s0 = (# divLoop (i +# 1#)+ (writeFloatArray# mat ((n +# 1#) *# i) 1.0#+ (loop' 0# i (loop' (i +# 1#) m s1))), y' #)+ where+ y0 = (n +# 1#) *# i +# 1# -- first element in source column+ !(# s1, y' #) = readFloatArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero+ yrc = 1.0# `divideFloat#` y'+ n' = n -# i -# 1#+ loop' k km s | isTrue# (k >=# km) = s+ | otherwise = loop' (k +# 1#) km+ ( let x0 = k *# n +# i+ !(# s', a' #) = readFloatArray# mat x0 s+ s'' = writeFloatArray# mat x0 0.0# s'+ a = a' `timesFloat#` yrc+ in multNRem# n' (x0 +# 1#) y0 a mat s''+ )+ divLoop k s | isTrue# (k >=# n) = s+ | otherwise = divLoop (k +# 1#)+ ( let x0 = n *# i +# k+ !(# s', x #) = readFloatArray# mat x0 s+ in writeFloatArray# mat x0 (timesFloat# x yrc) s'+ )+++-- | Remove a multiple of one row from another one.+-- do: xi = xi - yi*a+multNRem# :: Int# -- n - nr of elements to go through+ -> Int# -- start idx of x (update)+ -> Int# -- start idx of y (read)+ -> Float# -- multiplier a+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> State# s -- next state+multNRem# 0# _ _ _ _ s = s+multNRem# n x0 y0 a mat s = multNRem# (n -# 1#) (x0 +# 1#) (y0 +# 1#) a mat+ ( case readFloatArray# mat y0 s of+ (# s1, y #) -> case readFloatArray# mat x0 s1 of+ (# s2, x #) -> writeFloatArray# mat x0 (x `minusFloat#` timesFloat# y a) s2+ )++++-- | Gives index of maximum (absolute) element in i-th row, starting from i-th element only.+-- If i >= m then returns i.+maxInRowRem# :: Int# -- n+ -> Int# -- m+ -> Int# -- ith column to start to search for and a row to look in+ -> MutableByteArray# s -- byte array of matrix+ -> State# s -- previous state+ -> (# State# s, Int# #) -- next state+maxInRowRem# n m i mat s0 = loop' i (abs# v) i s1+ where+ !(# s1, v #) = readFloatArray# mat ((n +# 1#) *# i) s0+ abs# x = if isTrue# (x `geFloat#` 0.0#) then x else negateFloat# x+ loop' ok ov k s | isTrue# (k >=# m) = (# s, ok #)+ | otherwise = case readFloatArray# mat (n *# k +# i) s of+ (# s', v' #) -> if isTrue# (abs# v' `gtFloat#` ov)+ then loop' k (abs# v') (k +# 1#) s'+ else loop' ok ov (k +# 1#) s'++-- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1+loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s)+ -> State# s -> State# s+loop2# n m f = loop0 0# 0#+ where+ loop0 i j s | isTrue# (j ==# m) = s+ | isTrue# (i ==# n) = loop0 0# (j +# 1#) s+ | otherwise = case f i j s of s1 -> loop0 (i +# 1#) j s1+{-# INLINE loop2# #-}
+ src-base/Numeric/Array/Family/ArrayI.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayI+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayI+#define ARR_FROMSCALAR FromScalarI#+#define ARR_CONSTR ArrayI#+#define EL_TYPE_BOXED Int+#define EL_TYPE_PRIM Int#+#define EL_RUNTIME_REP 'IntRep+#define EL_CONSTR I#+#define EL_SIZE SIZEOF_HSINT#+#define EL_ALIGNMENT ALIGNMENT_HSINT#+#define EL_ZERO 0#+#define EL_ONE 1#+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexIntArray#+#define WRITE_ARRAY writeIntArray#+#define OP_EQ (==#)+#define OP_NE (/=#)+#define OP_GT (>#)+#define OP_GE (>=#)+#define OP_LT (<#)+#define OP_LE (<=#)+#define OP_PLUS (+#)+#define OP_MINUS (-#)+#define OP_TIMES (*#)+#define OP_NEGATE negateInt#+#include "Array.h"+++instance Num (ArrayI ds) where+ (+) = zipV (+#)+ {-# INLINE (+) #-}+ (-) = zipV (-#)+ {-# INLINE (-) #-}+ (*) = zipV (*#)+ {-# INLINE (*) #-}+ negate = mapV negateInt#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (x >=# 0#)+ then x+ else negateInt# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (x ># 0#)+ then 1#+ else if isTrue# (x <# 0#)+ then -1#+ else 0#+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Bounded (ArrayI ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayI16.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayI16+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI16 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Int (Int16 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayI16+#define ARR_FROMSCALAR FromScalarI16#+#define ARR_CONSTR ArrayI16#+#define EL_TYPE_BOXED Int16+#define EL_TYPE_PRIM Int#+#define EL_RUNTIME_REP 'IntRep+#define EL_CONSTR I16#+#define EL_SIZE SIZEOF_INT16#+#define EL_ALIGNMENT ALIGNMENT_INT16#+#define EL_ZERO 0#+#define EL_ONE 1#+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexInt16Array#+#define WRITE_ARRAY writeInt16Array#+#define OP_EQ (==#)+#define OP_NE (/=#)+#define OP_GT (>#)+#define OP_GE (>=#)+#define OP_LT (<#)+#define OP_LE (<=#)+#define OP_PLUS (+#)+#define OP_MINUS (-#)+#define OP_TIMES (*#)+#define OP_NEGATE negateInt#+#include "Array.h"+++instance Num (ArrayI16 ds) where+ (+) = zipV (+#)+ {-# INLINE (+) #-}+ (-) = zipV (-#)+ {-# INLINE (-) #-}+ (*) = zipV (*#)+ {-# INLINE (*) #-}+ negate = mapV negateInt#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (x >=# 0#)+ then x+ else negateInt# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (x ># 0#)+ then 1#+ else if isTrue# (x <# 0#)+ then -1#+ else 0#+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Bounded (ArrayI16 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayI32.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayI32+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI32 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Int (Int32 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayI32+#define ARR_FROMSCALAR FromScalarI32#+#define ARR_CONSTR ArrayI32#+#define EL_TYPE_BOXED Int32+#define EL_TYPE_PRIM Int#+#define EL_RUNTIME_REP 'IntRep+#define EL_CONSTR I32#+#define EL_SIZE SIZEOF_INT32#+#define EL_ALIGNMENT ALIGNMENT_INT32#+#define EL_ZERO 0#+#define EL_ONE 1#+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexInt32Array#+#define WRITE_ARRAY writeInt32Array#+#define OP_EQ (==#)+#define OP_NE (/=#)+#define OP_GT (>#)+#define OP_GE (>=#)+#define OP_LT (<#)+#define OP_LE (<=#)+#define OP_PLUS (+#)+#define OP_MINUS (-#)+#define OP_TIMES (*#)+#define OP_NEGATE negateInt#+#include "Array.h"+++instance Num (ArrayI32 ds) where+ (+) = zipV (+#)+ {-# INLINE (+) #-}+ (-) = zipV (-#)+ {-# INLINE (-) #-}+ (*) = zipV (*#)+ {-# INLINE (*) #-}+ negate = mapV negateInt#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (x >=# 0#)+ then x+ else negateInt# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (x ># 0#)+ then 1#+ else if isTrue# (x <# 0#)+ then -1#+ else 0#+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Bounded (ArrayI32 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayI64.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayI64+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI64 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Int (Int64 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayI64+#define ARR_FROMSCALAR FromScalarI64#+#define ARR_CONSTR ArrayI64#+#define EL_TYPE_BOXED Int64+#define EL_TYPE_PRIM Int#+#define EL_RUNTIME_REP 'IntRep+#define EL_CONSTR I64#+#define EL_SIZE SIZEOF_INT64#+#define EL_ALIGNMENT ALIGNMENT_INT64#+#define EL_ZERO 0#+#define EL_ONE 1#+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexInt64Array#+#define WRITE_ARRAY writeInt64Array#+#define OP_EQ (==#)+#define OP_NE (/=#)+#define OP_GT (>#)+#define OP_GE (>=#)+#define OP_LT (<#)+#define OP_LE (<=#)+#define OP_PLUS (+#)+#define OP_MINUS (-#)+#define OP_TIMES (*#)+#define OP_NEGATE negateInt#+#include "Array.h"+++instance Num (ArrayI64 ds) where+ (+) = zipV (+#)+ {-# INLINE (+) #-}+ (-) = zipV (-#)+ {-# INLINE (-) #-}+ (*) = zipV (*#)+ {-# INLINE (*) #-}+ negate = mapV negateInt#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (x >=# 0#)+ then x+ else negateInt# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (x ># 0#)+ then 1#+ else if isTrue# (x <# 0#)+ then -1#+ else 0#+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Bounded (ArrayI64 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayI8.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayI8+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayI8 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Int (Int8 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayI8+#define ARR_FROMSCALAR FromScalarI8#+#define ARR_CONSTR ArrayI8#+#define EL_TYPE_BOXED Int8+#define EL_TYPE_PRIM Int#+#define EL_RUNTIME_REP 'IntRep+#define EL_CONSTR I8#+#define EL_SIZE SIZEOF_INT8#+#define EL_ALIGNMENT ALIGNMENT_INT8#+#define EL_ZERO 0#+#define EL_ONE 1#+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexInt8Array#+#define WRITE_ARRAY writeInt8Array#+#define OP_EQ (==#)+#define OP_NE (/=#)+#define OP_GT (>#)+#define OP_GE (>=#)+#define OP_LT (<#)+#define OP_LE (<=#)+#define OP_PLUS (+#)+#define OP_MINUS (-#)+#define OP_TIMES (*#)+#define OP_NEGATE negateInt#+#include "Array.h"+++instance Num (ArrayI8 ds) where+ (+) = zipV (+#)+ {-# INLINE (+) #-}+ (-) = zipV (-#)+ {-# INLINE (-) #-}+ (*) = zipV (*#)+ {-# INLINE (*) #-}+ negate = mapV negateInt#+ {-# INLINE negate #-}+ abs = mapV (\x -> if isTrue# (x >=# 0#)+ then x+ else negateInt# x+ )+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (x ># 0#)+ then 1#+ else if isTrue# (x <# 0#)+ then -1#+ else 0#+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}++instance Bounded (ArrayI8 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayW.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayW+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Word (..), Int (..), RuntimeRep (..), isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayW+#define ARR_FROMSCALAR FromScalarW#+#define ARR_CONSTR ArrayW#+#define EL_TYPE_BOXED Word+#define EL_TYPE_PRIM Word#+#define EL_RUNTIME_REP 'WordRep+#define EL_CONSTR W#+#define EL_SIZE SIZEOF_HSWORD#+#define EL_ALIGNMENT ALIGNMENT_HSWORD#+#define EL_ZERO 0##+#define EL_ONE 1##+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexWordArray#+#define WRITE_ARRAY writeWordArray#+#define OP_EQ eqWord#+#define OP_NE neWord#+#define OP_GT gtWord#+#define OP_GE geWord#+#define OP_LT ltWord#+#define OP_LE leWord#+#define OP_PLUS plusWord#+#define OP_MINUS minusWord#+#define OP_TIMES timesWord#+#include "Array.h"++instance Num (ArrayW ds) where+ (+) = zipV plusWord#+ {-# INLINE (+) #-}+ (-) = zipV minusWord#+ {-# INLINE (-) #-}+ (*) = zipV timesWord#+ {-# INLINE (*) #-}+ negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+ {-# INLINE negate #-}+ abs = id+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (gtWord# x 0##)+ then 1##+ else 0##+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}+++instance Bounded (ArrayW ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayW16.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayW16+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW16 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Word (Word16 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayW16+#define ARR_FROMSCALAR FromScalarW16#+#define ARR_CONSTR ArrayW16#+#define EL_TYPE_BOXED Word16+#define EL_TYPE_PRIM Word#+#define EL_RUNTIME_REP 'WordRep+#define EL_CONSTR W16#+#define EL_SIZE SIZEOF_WORD16#+#define EL_ALIGNMENT ALIGNMENT_WORD16#+#define EL_ZERO 0##+#define EL_ONE 1##+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexWord16Array#+#define WRITE_ARRAY writeWord16Array#+#define OP_EQ eqWord#+#define OP_NE neWord#+#define OP_GT gtWord#+#define OP_GE geWord#+#define OP_LT ltWord#+#define OP_LE leWord#+#define OP_PLUS plusWord#+#define OP_MINUS minusWord#+#define OP_TIMES timesWord#+#include "Array.h"++instance Num (ArrayW16 ds) where+ (+) = zipV plusWord#+ {-# INLINE (+) #-}+ (-) = zipV minusWord#+ {-# INLINE (-) #-}+ (*) = zipV timesWord#+ {-# INLINE (*) #-}+ negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+ {-# INLINE negate #-}+ abs = id+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (gtWord# x 0##)+ then 1##+ else 0##+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}+++instance Bounded (ArrayW16 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayW32.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayW32+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW32 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Word (Word32 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayW32+#define ARR_FROMSCALAR FromScalarW32#+#define ARR_CONSTR ArrayW32#+#define EL_TYPE_BOXED Word32+#define EL_TYPE_PRIM Word#+#define EL_RUNTIME_REP 'WordRep+#define EL_CONSTR W32#+#define EL_SIZE SIZEOF_WORD32#+#define EL_ALIGNMENT ALIGNMENT_WORD32#+#define EL_ZERO 0##+#define EL_ONE 1##+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexWord32Array#+#define WRITE_ARRAY writeWord32Array#+#define OP_EQ eqWord#+#define OP_NE neWord#+#define OP_GT gtWord#+#define OP_GE geWord#+#define OP_LT ltWord#+#define OP_LE leWord#+#define OP_PLUS plusWord#+#define OP_MINUS minusWord#+#define OP_TIMES timesWord#+#include "Array.h"++instance Num (ArrayW32 ds) where+ (+) = zipV plusWord#+ {-# INLINE (+) #-}+ (-) = zipV minusWord#+ {-# INLINE (-) #-}+ (*) = zipV timesWord#+ {-# INLINE (*) #-}+ negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+ {-# INLINE negate #-}+ abs = id+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (gtWord# x 0##)+ then 1##+ else 0##+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}+++instance Bounded (ArrayW32 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayW64.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayW64+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW64 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Word (Word64 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayW64+#define ARR_FROMSCALAR FromScalarW64#+#define ARR_CONSTR ArrayW64#+#define EL_TYPE_BOXED Word64+#define EL_TYPE_PRIM Word#+#define EL_RUNTIME_REP 'WordRep+#define EL_CONSTR W64#+#define EL_SIZE SIZEOF_WORD64#+#define EL_ALIGNMENT ALIGNMENT_WORD64#+#define EL_ZERO 0##+#define EL_ONE 1##+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexWord64Array#+#define WRITE_ARRAY writeWord64Array#+#define OP_EQ eqWord#+#define OP_NE neWord#+#define OP_GT gtWord#+#define OP_GE geWord#+#define OP_LT ltWord#+#define OP_LE leWord#+#define OP_PLUS plusWord#+#define OP_MINUS minusWord#+#define OP_TIMES timesWord#+#include "Array.h"++instance Num (ArrayW64 ds) where+ (+) = zipV plusWord#+ {-# INLINE (+) #-}+ (-) = zipV minusWord#+ {-# INLINE (-) #-}+ (*) = zipV timesWord#+ {-# INLINE (*) #-}+ negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+ {-# INLINE negate #-}+ abs = id+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (gtWord# x 0##)+ then 1##+ else 0##+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}+++instance Bounded (ArrayW64 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/ArrayW8.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.ArrayW8+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.ArrayW8 () where++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), isTrue#)+import GHC.Word (Word8 (..))++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+++#include "MachDeps.h"+#define ARR_TYPE ArrayW8+#define ARR_FROMSCALAR FromScalarW8#+#define ARR_CONSTR ArrayW8#+#define EL_TYPE_BOXED Word8+#define EL_TYPE_PRIM Word#+#define EL_RUNTIME_REP 'WordRep+#define EL_CONSTR W8#+#define EL_SIZE SIZEOF_WORD8#+#define EL_ALIGNMENT ALIGNMENT_WORD8#+#define EL_ZERO 0##+#define EL_ONE 1##+#define EL_MINUS_ONE -1#+#define INDEX_ARRAY indexWord8Array#+#define WRITE_ARRAY writeWord8Array#+#define OP_EQ eqWord#+#define OP_NE neWord#+#define OP_GT gtWord#+#define OP_GE geWord#+#define OP_LT ltWord#+#define OP_LE leWord#+#define OP_PLUS plusWord#+#define OP_MINUS minusWord#+#define OP_TIMES timesWord#+#include "Array.h"++instance Num (ArrayW8 ds) where+ (+) = zipV plusWord#+ {-# INLINE (+) #-}+ (-) = zipV minusWord#+ {-# INLINE (-) #-}+ (*) = zipV timesWord#+ {-# INLINE (*) #-}+ negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))+ {-# INLINE negate #-}+ abs = id+ {-# INLINE abs #-}+ signum = mapV (\x -> if isTrue# (gtWord# x 0##)+ then 1##+ else 0##+ )+ {-# INLINE signum #-}+ fromInteger = broadcastArray . fromInteger+ {-# INLINE fromInteger #-}+++instance Bounded (ArrayW8 ds) where+ minBound = broadcastArray minBound+ maxBound = broadcastArray maxBound
+ src-base/Numeric/Array/Family/FloatX2.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.FloatX2+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.FloatX2 () where+++#include "MachDeps.h"++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Float (..), RuntimeRep (..),+ isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions++++++instance Show FloatX2 where+ show (FloatX2# a1 a2) = "{ " ++ show (F# a1)+ ++ ", " ++ show (F# a2)+ ++ " }"++++instance Eq FloatX2 where+ FloatX2# a1 a2 == FloatX2# b1 b2 = isTrue# ( (a1 `eqFloat#` b1)+ `andI#` (a2 `eqFloat#` b2)+ )+ {-# INLINE (==) #-}+ FloatX2# a1 a2 /= FloatX2# b1 b2 = isTrue# ( (a1 `neFloat#` b1)+ `orI#` (a2 `neFloat#` b2)+ )+ {-# INLINE (/=) #-}++++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+-- and lexicographical ordering for `compare`+instance Ord FloatX2 where+ FloatX2# a1 a2 > FloatX2# b1 b2 = isTrue# ( (a1 `gtFloat#` b1)+ `andI#` (a2 `gtFloat#` b2)+ )+ {-# INLINE (>) #-}+ FloatX2# a1 a2 < FloatX2# b1 b2 = isTrue# ( (a1 `ltFloat#` b1)+ `andI#` (a2 `ltFloat#` b2)+ )+ {-# INLINE (<) #-}+ FloatX2# a1 a2 >= FloatX2# b1 b2 = isTrue# ( (a1 `geFloat#` b1)+ `andI#` (a2 `geFloat#` b2)+ )+ {-# INLINE (>=) #-}+ FloatX2# a1 a2 <= FloatX2# b1 b2 = isTrue# ( (a1 `leFloat#` b1)+ `andI#` (a2 `leFloat#` b2)+ )+ {-# INLINE (<=) #-}+ -- | Compare lexicographically+ compare (FloatX2# a1 a2) (FloatX2# b1 b2)+ | isTrue# (a1 `gtFloat#` b1) = GT+ | isTrue# (a1 `ltFloat#` b1) = LT+ | isTrue# (a2 `gtFloat#` b2) = GT+ | isTrue# (a2 `ltFloat#` b2) = LT+ | otherwise = EQ+ {-# INLINE compare #-}+ -- | Element-wise minimum+ min (FloatX2# a1 a2) (FloatX2# b1 b2) =+ FloatX2# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)+ (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)+ {-# INLINE min #-}+ -- | Element-wise maximum+ max (FloatX2# a1 a2) (FloatX2# b1 b2) =+ FloatX2# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)+ (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)+ {-# INLINE max #-}++++-- | element-wise operations for vectors+instance Num FloatX2 where+ FloatX2# a1 a2 + FloatX2# b1 b2+ = FloatX2# (plusFloat# a1 b1) (plusFloat# a2 b2)+ {-# INLINE (+) #-}+ FloatX2# a1 a2 - FloatX2# b1 b2+ = FloatX2# (minusFloat# a1 b1) (minusFloat# a2 b2)+ {-# INLINE (-) #-}+ FloatX2# a1 a2 * FloatX2# b1 b2+ = FloatX2# (timesFloat# a1 b1) (timesFloat# a2 b2)+ {-# INLINE (*) #-}+ negate (FloatX2# a1 a2)+ = FloatX2# (negateFloat# a1) (negateFloat# a2)+ {-# INLINE negate #-}+ abs (FloatX2# a1 a2)+ = FloatX2# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)+ (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)+ {-# INLINE abs #-}+ signum (FloatX2# a1 a2)+ = FloatX2# (if isTrue# (a1 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ (if isTrue# (a2 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ {-# INLINE signum #-}+ fromInteger n = case fromInteger n of F# x -> FloatX2# x x+ {-# INLINE fromInteger #-}++++instance Fractional FloatX2 where+ FloatX2# a1 a2 / FloatX2# b1 b2 = FloatX2# (divideFloat# a1 b1)+ (divideFloat# a2 b2)+ {-# INLINE (/) #-}+ recip (FloatX2# a1 a2) = FloatX2# (divideFloat# 1.0# a1)+ (divideFloat# 1.0# a2)+ {-# INLINE recip #-}+ fromRational r = case fromRational r of F# x -> FloatX2# x x+ {-# INLINE fromRational #-}++++instance Floating FloatX2 where+ pi = FloatX2# 3.141592653589793238# 3.141592653589793238#+ {-# INLINE pi #-}+ exp (FloatX2# a1 a2) = FloatX2# (expFloat# a1)+ (expFloat# a2)+ {-# INLINE exp #-}+ log (FloatX2# a1 a2) = FloatX2# (logFloat# a1)+ (logFloat# a2)+ {-# INLINE log #-}+ sqrt (FloatX2# a1 a2) = FloatX2# (sqrtFloat# a1)+ (sqrtFloat# a2)+ {-# INLINE sqrt #-}+ sin (FloatX2# a1 a2) = FloatX2# (sinFloat# a1)+ (sinFloat# a2)+ {-# INLINE sin #-}+ cos (FloatX2# a1 a2) = FloatX2# (cosFloat# a1)+ (cosFloat# a2)+ {-# INLINE cos #-}+ tan (FloatX2# a1 a2) = FloatX2# (tanFloat# a1)+ (tanFloat# a2)+ {-# INLINE tan #-}+ asin (FloatX2# a1 a2) = FloatX2# (asinFloat# a1)+ (asinFloat# a2)+ {-# INLINE asin #-}+ acos (FloatX2# a1 a2) = FloatX2# (acosFloat# a1)+ (acosFloat# a2)+ {-# INLINE acos #-}+ atan (FloatX2# a1 a2) = FloatX2# (atanFloat# a1)+ (atanFloat# a2)+ {-# INLINE atan #-}+ sinh (FloatX2# a1 a2) = FloatX2# (sinFloat# a1)+ (sinFloat# a2)+ {-# INLINE sinh #-}+ cosh (FloatX2# a1 a2) = FloatX2# (coshFloat# a1)+ (coshFloat# a2)+ {-# INLINE cosh #-}+ tanh (FloatX2# a1 a2) = FloatX2# (tanhFloat# a1)+ (tanhFloat# a2)+ {-# INLINE tanh #-}+ FloatX2# a1 a2 ** FloatX2# b1 b2 = FloatX2# (powerFloat# a1 b1)+ (powerFloat# a2 b2)+ {-# INLINE (**) #-}++ logBase x y = log y / log x+ {-# INLINE logBase #-}+ asinh x = log (x + sqrt (1.0+x*x))+ {-# INLINE asinh #-}+ acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))+ {-# INLINE acosh #-}+ atanh x = 0.5 * log ((1.0+x) / (1.0-x))+ {-# INLINE atanh #-}++++-- log1p (FloatX2# a1 a2) = case ( log1p (F# a1), log1p (F# a2) ) of+-- (F# x1, F# x2) -> FloatX2# x1 x2+-- expm1 (FloatX2# a1 a2) = case ( expm1 (F# a1), expm1 (F# a2) ) of+-- (F# x1, F# x2) -> FloatX2# x1 x2+--+-- log1mexp a+-- | a <= log 2 = log (negate (expm1Float a))+-- | otherwise = log1p (negate (exp a))+-- {-# INLINE log1mexp #-}+-- log1pexp a+-- | a <= 18 = log1p (exp a)+-- | a <= 100 = a + exp (negate a)+-- | otherwise = a+-- {-# INLINE log1pexp #-}++++-- instance VectorCalculus Float 2 FloatX2 where+-- broadcastVec (F# x) = FloatX2# x x+-- {-# INLINE broadcastVec #-}+-- FloatX2# a1 a2 .*. FloatX2# b1 b2 = case timesFloat# a1 b1+-- `plusFloat#` timesFloat# a2 b2 of+-- x -> FloatX2# x x+-- {-# INLINE (.*.) #-}+-- FloatX2# a1 a2 `dot` FloatX2# b1 b2 = F# ( timesFloat# a1 b1+-- `plusFloat#` timesFloat# a2 b2+-- )+-- {-# INLINE dot #-}+-- indexVec 1 (FloatX2# a1 _) = F# a1+-- indexVec 2 (FloatX2# _ a2) = F# a2+-- indexVec i _ = error $ "Bad index " ++ show i ++ " for 2D vector"+-- {-# INLINE indexVec #-}+-- normL1 v = case abs v of+-- FloatX2# a1 a2 -> F# (a1 `plusFloat#` a2)+-- {-# INLINE normL1 #-}+-- normL2 v = sqrt $ dot v v+-- {-# INLINE normL2 #-}+-- normLPInf (FloatX2# a1 a2)+-- = F# (if isTrue# (a1 `gtFloat#` a2) then a1 else a2)+-- {-# INLINE normLPInf #-}+-- normLNInf (FloatX2# a1 a2)+-- = F# (if isTrue# (a1 `gtFloat#` a2) then a2 else a1)+-- {-# INLINE normLNInf #-}+-- normLP n (FloatX2# a1 a2) = case realToFrac n of+-- F# x -> F# ( powerFloat# (divideFloat# 1.0# x)+-- ( powerFloat# a1 x+-- `plusFloat#` powerFloat# a2 x+-- )+-- )+-- {-# INLINE normLP #-}+-- dim _ = 2+-- {-# INLINE dim #-}+--+--+--+--+-- instance Vector2D Float where+-- vec2 (F# x) (F# y) = FloatX2# x y+-- {-# INLINE vec2 #-}+-- det2 (FloatX2# a1 a2) (FloatX2# b1 b2)+-- = F# (timesFloat# a1 b2 `minusFloat#` timesFloat# a2 b1)+-- {-# INLINE det2 #-}++type instance ElemRep FloatX2 = 'FloatRep+type instance ElemPrim FloatX2 = Float#+instance PrimBytes FloatX2 where+ toBytes (FloatX2# a1 a2) = case runRW#+ ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 2#) s0 of+ (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of+ s2 -> case writeFloatArray# marr 1# a2 s2 of+ s3 -> unsafeFreezeByteArray# marr s3+ ) of (# _, a #) -> (# 0#, 2#, a #)+ {-# INLINE toBytes #-}+ fromBytes (# off, _, arr #) = FloatX2#+ (indexFloatArray# arr off)+ (indexFloatArray# arr (off +# 1#))+ {-# INLINE fromBytes #-}+ byteSize _ = SIZEOF_HSFLOAT# *# 2#+ {-# INLINE byteSize #-}+ byteAlign _ = ALIGNMENT_HSFLOAT#+ {-# INLINE byteAlign #-}+ elementByteSize _ = SIZEOF_HSFLOAT#+ {-# INLINE elementByteSize #-}+ ix 0# (FloatX2# a1 _) = a1+ ix 1# (FloatX2# _ a2) = a2+ ix _ _ = undefined+ {-# INLINE ix #-}+++instance ElementWise (Idx '[2]) Float FloatX2 where+ indexOffset# (FloatX2# a1 _) 0# = F# a1+ indexOffset# (FloatX2# _ a2) 1# = F# a2+ indexOffset# _ _ = undefined+ {-# INLINE indexOffset# #-}++ (!) (FloatX2# a1 _) ( 1 :! Z) = F# a1+ (!) (FloatX2# _ a2) ( 2 :! Z) = F# a2+ (!) _ ( _ :! Z) = undefined+ {-# INLINE (!) #-}++ broadcast (F# x) = FloatX2# x x+ {-# INLINE broadcast #-}++ ewmap f (FloatX2# x y) = case (f (1:!Z) (F# x), f (2:!Z) (F# y)) of+ (F# r1, F# r2) -> FloatX2# r1 r2+ {-# INLINE ewmap #-}++ ewgen f = case (f (1:!Z), f (2:!Z)) of (F# r1, F# r2) -> FloatX2# r1 r2+ {-# INLINE ewgen #-}++ ewgenA f = (\(F# r1) (F# r2) -> FloatX2# r1 r2) <$> f (1:!Z) <*> f (2:!Z)+ {-# INLINE ewgenA #-}++ ewfoldl f x0 (FloatX2# x y) = f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)+ {-# INLINE ewfoldl #-}++ ewfoldr f x0 (FloatX2# x y) = f (1:!Z) (F# x) (f (2:!Z) (F# y) x0)+ {-# INLINE ewfoldr #-}++ elementWise f (FloatX2# x y) = (\(F# a) (F# b) -> FloatX2# a b)+ <$> f (F# x) <*> f (F# y)+ {-# INLINE elementWise #-}++ indexWise f (FloatX2# x y) = (\(F# a) (F# b) -> FloatX2# a b)+ <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y)+ {-# INLINE indexWise #-}++ update (1 :! Z) (F# q) (FloatX2# _ y) = FloatX2# q y+ update (2 :! Z) (F# q) (FloatX2# x _) = FloatX2# x q+ update (_ :! Z) _ x = x+ {-# INLINE update #-}
+ src-base/Numeric/Array/Family/FloatX3.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.FloatX3+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.FloatX3 () where+++#include "MachDeps.h"++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Float (..), RuntimeRep (..),+ isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions++++++instance Show FloatX3 where+ show (FloatX3# a1 a2 a3) = "{ " ++ show (F# a1)+ ++ ", " ++ show (F# a2)+ ++ ", " ++ show (F# a3)+ ++ " }"++++instance Eq FloatX3 where+ FloatX3# a1 a2 a3 == FloatX3# b1 b2 b3 = isTrue# ( (a1 `eqFloat#` b1)+ `andI#` (a2 `eqFloat#` b2)+ `andI#` (a3 `eqFloat#` b3)+ )+ {-# INLINE (==) #-}+ FloatX3# a1 a2 a3 /= FloatX3# b1 b2 b3 = isTrue# ( (a1 `neFloat#` b1)+ `orI#` (a2 `neFloat#` b2)+ `orI#` (a3 `neFloat#` b3)+ )+ {-# INLINE (/=) #-}++++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+-- and lexicographical ordering for `compare`+instance Ord FloatX3 where+ FloatX3# a1 a2 a3 > FloatX3# b1 b2 b3 = isTrue# ( (a1 `gtFloat#` b1)+ `andI#` (a2 `gtFloat#` b2)+ `andI#` (a3 `gtFloat#` b3)+ )+ {-# INLINE (>) #-}+ FloatX3# a1 a2 a3 < FloatX3# b1 b2 b3 = isTrue# ( (a1 `ltFloat#` b1)+ `andI#` (a2 `ltFloat#` b2)+ `andI#` (a3 `ltFloat#` b3)+ )+ {-# INLINE (<) #-}+ FloatX3# a1 a2 a3 >= FloatX3# b1 b2 b3 = isTrue# ( (a1 `geFloat#` b1)+ `andI#` (a2 `geFloat#` b2)+ `andI#` (a3 `geFloat#` b3)+ )+ {-# INLINE (>=) #-}+ FloatX3# a1 a2 a3 <= FloatX3# b1 b2 b3 = isTrue# ( (a1 `leFloat#` b1)+ `andI#` (a2 `leFloat#` b2)+ `andI#` (a3 `leFloat#` b3)+ )+ {-# INLINE (<=) #-}+ -- | Compare lexicographically+ compare (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3)+ | isTrue# (a1 `gtFloat#` b1) = GT+ | isTrue# (a1 `ltFloat#` b1) = LT+ | isTrue# (a2 `gtFloat#` b2) = GT+ | isTrue# (a2 `ltFloat#` b2) = LT+ | isTrue# (a3 `gtFloat#` b3) = GT+ | isTrue# (a3 `ltFloat#` b3) = LT+ | otherwise = EQ+ {-# INLINE compare #-}+ -- | Element-wise minimum+ min (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3) =+ FloatX3# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)+ (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)+ (if isTrue# (a3 `gtFloat#` b3) then b3 else a3)+ {-# INLINE min #-}+ -- | Element-wise maximum+ max (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3) =+ FloatX3# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)+ (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)+ (if isTrue# (a3 `gtFloat#` b3) then a3 else b3)+ {-# INLINE max #-}++++-- | element-wise operations for vectors+instance Num FloatX3 where+ FloatX3# a1 a2 a3 + FloatX3# b1 b2 b3+ = FloatX3# (plusFloat# a1 b1) (plusFloat# a2 b2) (plusFloat# a3 b3)+ {-# INLINE (+) #-}+ FloatX3# a1 a2 a3 - FloatX3# b1 b2 b3+ = FloatX3# (minusFloat# a1 b1) (minusFloat# a2 b2) (minusFloat# a3 b3)+ {-# INLINE (-) #-}+ FloatX3# a1 a2 a3 * FloatX3# b1 b2 b3+ = FloatX3# (timesFloat# a1 b1) (timesFloat# a2 b2) (timesFloat# a3 b3)+ {-# INLINE (*) #-}+ negate (FloatX3# a1 a2 a3)+ = FloatX3# (negateFloat# a1) (negateFloat# a2) (negateFloat# a3)+ {-# INLINE negate #-}+ abs (FloatX3# a1 a2 a3)+ = FloatX3# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)+ (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)+ (if isTrue# (a3 `geFloat#` 0.0#) then a3 else negateFloat# a3)+ {-# INLINE abs #-}+ signum (FloatX3# a1 a2 a3)+ = FloatX3# (if isTrue# (a1 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ (if isTrue# (a2 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ (if isTrue# (a3 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a3 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ {-# INLINE signum #-}+ fromInteger n = case fromInteger n of F# x -> FloatX3# x x x+ {-# INLINE fromInteger #-}++++instance Fractional FloatX3 where+ FloatX3# a1 a2 a3 / FloatX3# b1 b2 b3 = FloatX3# (divideFloat# a1 b1)+ (divideFloat# a2 b2)+ (divideFloat# a3 b3)+ {-# INLINE (/) #-}+ recip (FloatX3# a1 a2 a3) = FloatX3# (divideFloat# 1.0# a1)+ (divideFloat# 1.0# a2)+ (divideFloat# 1.0# a3)+ {-# INLINE recip #-}+ fromRational r = case fromRational r of F# x -> FloatX3# x x x+ {-# INLINE fromRational #-}++++instance Floating FloatX3 where+ pi = FloatX3# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238#+ {-# INLINE pi #-}+ exp (FloatX3# a1 a2 a3) = FloatX3# (expFloat# a1)+ (expFloat# a2)+ (expFloat# a3)+ {-# INLINE exp #-}+ log (FloatX3# a1 a2 a3) = FloatX3# (logFloat# a1)+ (logFloat# a2)+ (logFloat# a3)+ {-# INLINE log #-}+ sqrt (FloatX3# a1 a2 a3) = FloatX3# (sqrtFloat# a1)+ (sqrtFloat# a2)+ (sqrtFloat# a3)+ {-# INLINE sqrt #-}+ sin (FloatX3# a1 a2 a3) = FloatX3# (sinFloat# a1)+ (sinFloat# a2)+ (sinFloat# a3)+ {-# INLINE sin #-}+ cos (FloatX3# a1 a2 a3) = FloatX3# (cosFloat# a1)+ (cosFloat# a2)+ (cosFloat# a3)+ {-# INLINE cos #-}+ tan (FloatX3# a1 a2 a3) = FloatX3# (tanFloat# a1)+ (tanFloat# a2)+ (tanFloat# a3)+ {-# INLINE tan #-}+ asin (FloatX3# a1 a2 a3) = FloatX3# (asinFloat# a1)+ (asinFloat# a2)+ (asinFloat# a3)+ {-# INLINE asin #-}+ acos (FloatX3# a1 a2 a3) = FloatX3# (acosFloat# a1)+ (acosFloat# a2)+ (acosFloat# a3)+ {-# INLINE acos #-}+ atan (FloatX3# a1 a2 a3) = FloatX3# (atanFloat# a1)+ (atanFloat# a2)+ (atanFloat# a3)+ {-# INLINE atan #-}+ sinh (FloatX3# a1 a2 a3) = FloatX3# (sinFloat# a1)+ (sinFloat# a2)+ (sinFloat# a3)+ {-# INLINE sinh #-}+ cosh (FloatX3# a1 a2 a3) = FloatX3# (coshFloat# a1)+ (coshFloat# a2)+ (coshFloat# a3)+ {-# INLINE cosh #-}+ tanh (FloatX3# a1 a2 a3) = FloatX3# (tanhFloat# a1)+ (tanhFloat# a2)+ (tanhFloat# a3)+ {-# INLINE tanh #-}+ FloatX3# a1 a2 a3 ** FloatX3# b1 b2 b3 = FloatX3# (powerFloat# a1 b1)+ (powerFloat# a2 b2)+ (powerFloat# a3 b3)+ {-# INLINE (**) #-}++ logBase x y = log y / log x+ {-# INLINE logBase #-}+ asinh x = log (x + sqrt (1.0+x*x))+ {-# INLINE asinh #-}+ acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))+ {-# INLINE acosh #-}+ atanh x = 0.5 * log ((1.0+x) / (1.0-x))+ {-# INLINE atanh #-}++++type instance ElemRep FloatX3 = 'FloatRep+type instance ElemPrim FloatX3 = Float#+instance PrimBytes FloatX3 where+ toBytes (FloatX3# a1 a2 a3) = case runRW#+ ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of+ (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of+ s2 -> case writeFloatArray# marr 1# a2 s2 of+ s3 -> case writeFloatArray# marr 2# a3 s3 of+ s4 -> unsafeFreezeByteArray# marr s4+ ) of (# _, a #) -> (# 0#, 3#, a #)+ {-# INLINE toBytes #-}+ fromBytes (# off, _, arr #) = FloatX3#+ (indexFloatArray# arr off)+ (indexFloatArray# arr (off +# 1#))+ (indexFloatArray# arr (off +# 2#))+ {-# INLINE fromBytes #-}+ byteSize _ = SIZEOF_HSFLOAT# *# 3#+ {-# INLINE byteSize #-}+ byteAlign _ = ALIGNMENT_HSFLOAT#+ {-# INLINE byteAlign #-}+ elementByteSize _ = SIZEOF_HSFLOAT#+ {-# INLINE elementByteSize #-}+ ix 0# (FloatX3# a1 _ _) = a1+ ix 1# (FloatX3# _ a2 _) = a2+ ix 2# (FloatX3# _ _ a3) = a3+ ix _ _ = undefined+ {-# INLINE ix #-}+++instance ElementWise (Idx '[3]) Float FloatX3 where+ indexOffset# (FloatX3# a1 _ _) 0# = F# a1+ indexOffset# (FloatX3# _ a2 _) 1# = F# a2+ indexOffset# (FloatX3# _ _ a3) 2# = F# a3+ indexOffset# _ _ = undefined+ {-# INLINE indexOffset# #-}++ (!) (FloatX3# a1 _ _) ( 1 :! Z) = F# a1+ (!) (FloatX3# _ a2 _) ( 2 :! Z) = F# a2+ (!) (FloatX3# _ _ a3) ( 3 :! Z) = F# a3+ (!) _ ( _ :! Z) = undefined+ {-# INLINE (!) #-}++ broadcast (F# x) = FloatX3# x x x+ {-# INLINE broadcast #-}++ ewmap f (FloatX3# x y z) = case (f (1:!Z) (F# x), f (2:!Z) (F# y), f (3:!Z) (F# z)) of+ (F# r1, F# r2, F# r3) -> FloatX3# r1 r2 r3+ {-# INLINE ewmap #-}++ ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z)) of (F# r1, F# r2, F# r3) -> FloatX3# r1 r2 r3+ {-# INLINE ewgen #-}++ ewgenA f = (\(F# r1) (F# r2) (F# r3) -> FloatX3# r1 r2 r3)+ <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z)+ {-# INLINE ewgenA #-}++ ewfoldl f x0 (FloatX3# x y z) = f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)) (F# z)+ {-# INLINE ewfoldl #-}++ ewfoldr f x0 (FloatX3# x y z) = f (1:!Z) (F# x) (f (2:!Z) (F# y) (f (3:!Z) (F# z) x0))+ {-# INLINE ewfoldr #-}++ elementWise f (FloatX3# x y z) = (\(F# a) (F# b) (F# c) -> FloatX3# a b c)+ <$> f (F# x) <*> f (F# y) <*> f (F# z)+ {-# INLINE elementWise #-}++ indexWise f (FloatX3# x y z) = (\(F# a) (F# b) (F# c) -> FloatX3# a b c)+ <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y) <*> f (3:!Z) (F# z)+ {-# INLINE indexWise #-}++ update (1 :! Z) (F# q) (FloatX3# _ y z) = FloatX3# q y z+ update (2 :! Z) (F# q) (FloatX3# x _ z) = FloatX3# x q z+ update (3 :! Z) (F# q) (FloatX3# x y _) = FloatX3# x y q+ update (_ :! Z) _ x = x+ {-# INLINE update #-}
+ src-base/Numeric/Array/Family/FloatX4.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family.FloatX4+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family.FloatX4 () where+++#include "MachDeps.h"++import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Float (..), RuntimeRep (..),+ isTrue#)++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.Dimensions++++++instance Show FloatX4 where+ show (FloatX4# a1 a2 a3 a4) = "{ " ++ show (F# a1)+ ++ ", " ++ show (F# a2)+ ++ ", " ++ show (F# a3)+ ++ ", " ++ show (F# a4)+ ++ " }"++++instance Eq FloatX4 where+ FloatX4# a1 a2 a3 a4 == FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `eqFloat#` b1)+ `andI#` (a2 `eqFloat#` b2)+ `andI#` (a3 `eqFloat#` b3)+ `andI#` (a4 `eqFloat#` b4)+ )+ {-# INLINE (==) #-}+ FloatX4# a1 a2 a3 a4 /= FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `neFloat#` b1)+ `orI#` (a2 `neFloat#` b2)+ `orI#` (a3 `neFloat#` b3)+ `orI#` (a4 `neFloat#` b4)+ )+ {-# INLINE (/=) #-}++++-- | Implement partial ordering for `>`, `<`, `>=`, `<=`+-- and lexicographical ordering for `compare`+instance Ord FloatX4 where+ FloatX4# a1 a2 a3 a4 > FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `gtFloat#` b1)+ `andI#` (a2 `gtFloat#` b2)+ `andI#` (a3 `gtFloat#` b3)+ `andI#` (a4 `gtFloat#` b4)+ )+ {-# INLINE (>) #-}+ FloatX4# a1 a2 a3 a4 < FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `ltFloat#` b1)+ `andI#` (a2 `ltFloat#` b2)+ `andI#` (a3 `ltFloat#` b3)+ `andI#` (a4 `ltFloat#` b4)+ )+ {-# INLINE (<) #-}+ FloatX4# a1 a2 a3 a4 >= FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `geFloat#` b1)+ `andI#` (a2 `geFloat#` b2)+ `andI#` (a3 `geFloat#` b3)+ `andI#` (a4 `geFloat#` b4)+ )+ {-# INLINE (>=) #-}+ FloatX4# a1 a2 a3 a4 <= FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `leFloat#` b1)+ `andI#` (a2 `leFloat#` b2)+ `andI#` (a3 `leFloat#` b3)+ `andI#` (a4 `leFloat#` b4)+ )+ {-# INLINE (<=) #-}+ -- | Compare lexicographically+ compare (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4)+ | isTrue# (a1 `gtFloat#` b1) = GT+ | isTrue# (a1 `ltFloat#` b1) = LT+ | isTrue# (a2 `gtFloat#` b2) = GT+ | isTrue# (a2 `ltFloat#` b2) = LT+ | isTrue# (a3 `gtFloat#` b3) = GT+ | isTrue# (a3 `ltFloat#` b3) = LT+ | isTrue# (a4 `gtFloat#` b4) = GT+ | isTrue# (a4 `ltFloat#` b4) = LT+ | otherwise = EQ+ {-# INLINE compare #-}+ -- | Element-wise minimum+ min (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4) =+ FloatX4# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)+ (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)+ (if isTrue# (a3 `gtFloat#` b3) then b3 else a3)+ (if isTrue# (a4 `gtFloat#` b4) then b4 else a4)+ {-# INLINE min #-}+ -- | Element-wise maximum+ max (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4) =+ FloatX4# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)+ (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)+ (if isTrue# (a3 `gtFloat#` b3) then a3 else b3)+ (if isTrue# (a4 `gtFloat#` b4) then a4 else b4)+ {-# INLINE max #-}++++-- | element-wise operations for vectors+instance Num FloatX4 where+ FloatX4# a1 a2 a3 a4 + FloatX4# b1 b2 b3 b4+ = FloatX4# (plusFloat# a1 b1) (plusFloat# a2 b2) (plusFloat# a3 b3) (plusFloat# a4 b4)+ {-# INLINE (+) #-}+ FloatX4# a1 a2 a3 a4 - FloatX4# b1 b2 b3 b4+ = FloatX4# (minusFloat# a1 b1) (minusFloat# a2 b2) (minusFloat# a3 b3) (minusFloat# a4 b4)+ {-# INLINE (-) #-}+ FloatX4# a1 a2 a3 a4 * FloatX4# b1 b2 b3 b4+ = FloatX4# (timesFloat# a1 b1) (timesFloat# a2 b2) (timesFloat# a3 b3) (timesFloat# a4 b4)+ {-# INLINE (*) #-}+ negate (FloatX4# a1 a2 a3 a4)+ = FloatX4# (negateFloat# a1) (negateFloat# a2) (negateFloat# a3) (negateFloat# a4)+ {-# INLINE negate #-}+ abs (FloatX4# a1 a2 a3 a4)+ = FloatX4# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)+ (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)+ (if isTrue# (a3 `geFloat#` 0.0#) then a3 else negateFloat# a3)+ (if isTrue# (a4 `geFloat#` 0.0#) then a4 else negateFloat# a4)+ {-# INLINE abs #-}+ signum (FloatX4# a1 a2 a3 a4)+ = FloatX4# (if isTrue# (a1 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ (if isTrue# (a2 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ (if isTrue# (a3 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a3 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ (if isTrue# (a4 `gtFloat#` 0.0#)+ then 1.0#+ else if isTrue# (a4 `ltFloat#` 0.0#) then -1.0# else 0.0# )+ {-# INLINE signum #-}+ fromInteger n = case fromInteger n of F# x -> FloatX4# x x x x+ {-# INLINE fromInteger #-}++++instance Fractional FloatX4 where+ FloatX4# a1 a2 a3 a4 / FloatX4# b1 b2 b3 b4 = FloatX4# (divideFloat# a1 b1)+ (divideFloat# a2 b2)+ (divideFloat# a3 b3)+ (divideFloat# a4 b4)+ {-# INLINE (/) #-}+ recip (FloatX4# a1 a2 a3 a4) = FloatX4# (divideFloat# 1.0# a1)+ (divideFloat# 1.0# a2)+ (divideFloat# 1.0# a3)+ (divideFloat# 1.0# a4)+ {-# INLINE recip #-}+ fromRational r = case fromRational r of F# x -> FloatX4# x x x x+ {-# INLINE fromRational #-}++++instance Floating FloatX4 where+ pi = FloatX4# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238#+ {-# INLINE pi #-}+ exp (FloatX4# a1 a2 a3 a4) = FloatX4# (expFloat# a1)+ (expFloat# a2)+ (expFloat# a3)+ (expFloat# a4)+ {-# INLINE exp #-}+ log (FloatX4# a1 a2 a3 a4) = FloatX4# (logFloat# a1)+ (logFloat# a2)+ (logFloat# a3)+ (logFloat# a4)+ {-# INLINE log #-}+ sqrt (FloatX4# a1 a2 a3 a4) = FloatX4# (sqrtFloat# a1)+ (sqrtFloat# a2)+ (sqrtFloat# a3)+ (sqrtFloat# a4)+ {-# INLINE sqrt #-}+ sin (FloatX4# a1 a2 a3 a4) = FloatX4# (sinFloat# a1)+ (sinFloat# a2)+ (sinFloat# a3)+ (sinFloat# a4)+ {-# INLINE sin #-}+ cos (FloatX4# a1 a2 a3 a4) = FloatX4# (cosFloat# a1)+ (cosFloat# a2)+ (cosFloat# a3)+ (cosFloat# a4)+ {-# INLINE cos #-}+ tan (FloatX4# a1 a2 a3 a4) = FloatX4# (tanFloat# a1)+ (tanFloat# a2)+ (tanFloat# a3)+ (tanFloat# a4)+ {-# INLINE tan #-}+ asin (FloatX4# a1 a2 a3 a4) = FloatX4# (asinFloat# a1)+ (asinFloat# a2)+ (asinFloat# a3)+ (asinFloat# a4)+ {-# INLINE asin #-}+ acos (FloatX4# a1 a2 a3 a4) = FloatX4# (acosFloat# a1)+ (acosFloat# a2)+ (acosFloat# a3)+ (acosFloat# a4)+ {-# INLINE acos #-}+ atan (FloatX4# a1 a2 a3 a4) = FloatX4# (atanFloat# a1)+ (atanFloat# a2)+ (atanFloat# a3)+ (atanFloat# a4)+ {-# INLINE atan #-}+ sinh (FloatX4# a1 a2 a3 a4) = FloatX4# (sinFloat# a1)+ (sinFloat# a2)+ (sinFloat# a3)+ (sinFloat# a4)+ {-# INLINE sinh #-}+ cosh (FloatX4# a1 a2 a3 a4) = FloatX4# (coshFloat# a1)+ (coshFloat# a2)+ (coshFloat# a3)+ (coshFloat# a4)+ {-# INLINE cosh #-}+ tanh (FloatX4# a1 a2 a3 a4) = FloatX4# (tanhFloat# a1)+ (tanhFloat# a2)+ (tanhFloat# a3)+ (tanhFloat# a4)+ {-# INLINE tanh #-}+ FloatX4# a1 a2 a3 a4 ** FloatX4# b1 b2 b3 b4 = FloatX4# (powerFloat# a1 b1)+ (powerFloat# a2 b2)+ (powerFloat# a3 b3)+ (powerFloat# a4 b4)+ {-# INLINE (**) #-}++ logBase x y = log y / log x+ {-# INLINE logBase #-}+ asinh x = log (x + sqrt (1.0+x*x))+ {-# INLINE asinh #-}+ acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))+ {-# INLINE acosh #-}+ atanh x = 0.5 * log ((1.0+x) / (1.0-x))+ {-# INLINE atanh #-}++++type instance ElemRep FloatX4 = 'FloatRep+type instance ElemPrim FloatX4 = Float#+instance PrimBytes FloatX4 where+ toBytes (FloatX4# a1 a2 a3 a4) = case runRW#+ ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of+ (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of+ s2 -> case writeFloatArray# marr 1# a2 s2 of+ s3 -> case writeFloatArray# marr 2# a3 s3 of+ s4 -> case writeFloatArray# marr 3# a4 s4 of+ s5 -> unsafeFreezeByteArray# marr s5+ ) of (# _, a #) -> (# 0#, 4#, a #)+ {-# INLINE toBytes #-}+ fromBytes (# off, _, arr #) = FloatX4#+ (indexFloatArray# arr off)+ (indexFloatArray# arr (off +# 1#))+ (indexFloatArray# arr (off +# 2#))+ (indexFloatArray# arr (off +# 3#))+ {-# INLINE fromBytes #-}+ byteSize _ = SIZEOF_HSFLOAT# *# 4#+ {-# INLINE byteSize #-}+ byteAlign _ = ALIGNMENT_HSFLOAT#+ {-# INLINE byteAlign #-}+ elementByteSize _ = SIZEOF_HSFLOAT#+ {-# INLINE elementByteSize #-}+ ix 0# (FloatX4# a1 _ _ _) = a1+ ix 1# (FloatX4# _ a2 _ _) = a2+ ix 2# (FloatX4# _ _ a3 _) = a3+ ix 3# (FloatX4# _ _ _ a4) = a4+ ix _ _ = undefined+ {-# INLINE ix #-}+++instance ElementWise (Idx '[4]) Float FloatX4 where+ indexOffset# (FloatX4# a1 _ _ _) 0# = F# a1+ indexOffset# (FloatX4# _ a2 _ _) 1# = F# a2+ indexOffset# (FloatX4# _ _ a3 _) 2# = F# a3+ indexOffset# (FloatX4# _ _ _ a4) 3# = F# a4+ indexOffset# _ _ = undefined+ {-# INLINE indexOffset# #-}++ (!) (FloatX4# a1 _ _ _) ( 1 :! Z) = F# a1+ (!) (FloatX4# _ a2 _ _) ( 2 :! Z) = F# a2+ (!) (FloatX4# _ _ a3 _) ( 3 :! Z) = F# a3+ (!) (FloatX4# _ _ _ a4) ( 4 :! Z) = F# a4+ (!) _ ( _ :! Z) = undefined+ {-# INLINE (!) #-}++ broadcast (F# x) = FloatX4# x x x x+ {-# INLINE broadcast #-}++ ewmap f (FloatX4# x y z w) = case (f (1:!Z) (F# x), f (2:!Z) (F# y), f (3:!Z) (F# z), f (3:!Z) (F# w)) of+ (F# r1, F# r2, F# r3, F# r4) -> FloatX4# r1 r2 r3 r4+ {-# INLINE ewmap #-}++ ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z), f (4:!Z)) of (F# r1, F# r2, F# r3, F# r4) -> FloatX4# r1 r2 r3 r4+ {-# INLINE ewgen #-}++ ewgenA f = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)+ <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z) <*> f (4:!Z)+ {-# INLINE ewgenA #-}++ ewfoldl f x0 (FloatX4# x y z w) = f (4:!Z) (f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)) (F# z)) (F# w)+ {-# INLINE ewfoldl #-}++ ewfoldr f x0 (FloatX4# x y z w) = f (1:!Z) (F# x) (f (2:!Z) (F# y) (f (3:!Z) (F# z) (f (4:!Z) (F# w) x0)))+ {-# INLINE ewfoldr #-}++ elementWise f (FloatX4# x y z w) = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)+ <$> f (F# x) <*> f (F# y) <*> f (F# z) <*> f (F# w)+ {-# INLINE elementWise #-}++ indexWise f (FloatX4# x y z w) = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)+ <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y) <*> f (3:!Z) (F# z) <*> f (4:!Z) (F# w)+ {-# INLINE indexWise #-}++ update (1 :! Z) (F# q) (FloatX4# _ y z w) = FloatX4# q y z w+ update (2 :! Z) (F# q) (FloatX4# x _ z w) = FloatX4# x q z w+ update (3 :! Z) (F# q) (FloatX4# x y _ w) = FloatX4# x y q w+ update (4 :! Z) (F# q) (FloatX4# x y z _) = FloatX4# x y z q+ update (_ :! Z) _ x = x+ {-# INLINE update #-}
+ src-base/Numeric/DataFrame/Contraction.hs view
@@ -0,0 +1,509 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE InstanceSigs #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.DataFrame.Contraction+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+-- This modules provides generalization of a matrix product:+-- tensor-like contraction.+-- For matrices and vectors this is a normal matrix*matrix or vector*matrix or matrix*vector product,+-- for larger dimensions it calculates the scalar product of "adjacent" dimesnions of a tensor.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Contraction+ ( Contraction (..), (%*)+ ) where+++import Data.Int (Int16, Int32, Int64, Int8)+import Data.Word (Word16, Word32, Word64, Word8)+import Data.Type.Equality ((:~:) (..))+import GHC.Base (runRW#)+import GHC.Prim+import GHC.Types (Int (..), RuntimeRep (..), Type,+ Word (..), isTrue#)+import Unsafe.Coerce (unsafeCoerce)++import Numeric.Array.Family+import Numeric.Commons+import Numeric.DataFrame.Type+import Numeric.Dimensions+import Numeric.TypeLits++++class ConcatList as bs asbs+ => Contraction (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+ | asbs as -> bs, asbs bs -> as, as bs -> asbs where+ -- | Generalization of a matrix product: take scalar product over one dimension+ -- and, thus, concatenate other dimesnions+ contract :: ( KnownDim m+ , PrimBytes (DataFrame t (as +: m))+ , PrimBytes (DataFrame t (m :+ bs))+ , PrimBytes (DataFrame t asbs)+ )+ => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs++-- | Tensor contraction.+-- In particular:+-- 1. matrix-matrix product+-- 2. matrix-vector or vector-matrix product+-- 3. dot product of two vectors.+(%*) :: ( ConcatList as bs (as ++ bs)+ , Contraction t as bs asbs+ , KnownDim m+ , PrimBytes (DataFrame t (as +: m))+ , PrimBytes (DataFrame t (m :+ bs))+ , PrimBytes (DataFrame t (as ++ bs))+ ) => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t (as ++ bs)+(%*) = contract+{-# INLINE (%*) #-}+infixl 7 %*+++--------------------------------------------------------------------------------++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Float as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Float (m : bs) ) :~: 'FloatRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Float (m : bs) ) :~: Float#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Float (as +: m)) :~: 'FloatRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Float (as +: m)) :~: Float#+ = prodF n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy+++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Double as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Double (m : bs) ) :~: 'DoubleRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Double (m : bs) ) :~: Double#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Double (as +: m)) :~: 'DoubleRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Double (as +: m)) :~: Double#+ = prodD n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Int as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int (m : bs) ) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int (m : bs) ) :~: Int#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int (as +: m)) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int (as +: m)) :~: Int#+ = prodI n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Int8 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int8 (m : bs) ) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int8 (m : bs) ) :~: Int#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int8 (as +: m)) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int8 (as +: m)) :~: Int#+ = prodI8 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Int16 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int16 (m : bs) ) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int16 (m : bs) ) :~: Int#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int16 (as +: m)) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int16 (as +: m)) :~: Int#+ = prodI16 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Int32 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int32 (m : bs) ) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int32 (m : bs) ) :~: Int#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int32 (as +: m)) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int32 (as +: m)) :~: Int#+ = prodI32 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy+++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Int64 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int64 (m : bs) ) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (m : bs) ) :~: Int#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Int64 (as +: m)) :~: 'IntRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (as +: m)) :~: Int#+ = prodI64 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Word as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word (m : bs) ) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word (m : bs) ) :~: Word#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word (as +: m)) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word (as +: m)) :~: Word#+ = prodW n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Word8 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word8 (m : bs) ) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word8 (m : bs) ) :~: Word#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word8 (as +: m)) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word8 (as +: m)) :~: Word#+ = prodW8 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Word16 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word16 (m : bs) ) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word16 (m : bs) ) :~: Word#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word16 (as +: m)) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word16 (as +: m)) :~: Word#+ = prodW16 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Word32 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word32 (m : bs) ) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word32 (m : bs) ) :~: Word#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word32 (as +: m)) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word32 (as +: m)) :~: Word#+ = prodW32 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction Word64 as bs asbs where+ contract x y+ | (pm :: Proxy m) <- getM y+ , I# m <- intNatVal pm+ , I# n <- totalDim (Proxy @as)+ , I# k <- totalDim (Proxy @bs)+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word64 (m : bs) ) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (m : bs) ) :~: Word#+ , Refl <- unsafeCoerce Refl :: ElemRep (Array Word64 (as +: m)) :~: 'WordRep+ , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (as +: m)) :~: Word#+ = prodW64 n m k x y+ where+ getM :: forall m p . p (m ': bs) -> Proxy m+ getM _ = Proxy++++prodF :: (FloatBytes a, FloatBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodF n m k x y = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r `plusFloat#` timesFloat# (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeFloatArray# marr (i +# n *# j) (loop' i j 0# 0.0#) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodF #-}++prodD :: (DoubleBytes a, DoubleBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodD n m k x y= case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r +## (*##) (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeDoubleArray# marr (i +# n *# j) (loop' i j 0# 0.0##) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodD #-}++prodI :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI n m k x y= case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeIntArray# marr (i +# n *# j) (loop' i j 0# 0#) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodI #-}++prodI8 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI8 n m k x y= case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeInt8Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodI8 #-}+++prodI16 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI16 n m k x y= case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeInt16Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodI16 #-}+++prodI32 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI32 n m k x y= case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeInt32Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodI32 #-}++prodI64 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodI64 n m k x y= case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeInt64Array# marr (i +# n *# j) (loop' i j 0# 0#) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodI64 #-}+++prodW :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW n m k x y = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeWordArray# marr (i +# n *# j) (loop' i j 0# 0##) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodW #-}++prodW8 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW8 n m k x y = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeWord8Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodW8 #-}+++prodW16 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW16 n m k x y = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeWord16Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodW16 #-}++prodW32 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW32 n m k x y = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeWord32Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodW32 #-}++prodW64 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c+prodW64 n m k x y = case runRW#+ ( \s0 -> case newByteArray# bs s0 of+ (# s1, marr #) ->+ let loop' i j l r | isTrue# (l ==# m) = r+ | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)+ (ix (l +# m *# j) y))+ in case loop2# n k+ (\i j s' -> writeWord64Array# marr (i +# n *# j) (loop' i j 0# 0##) s'+ ) s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)+ where+ bs = n *# k *# elementByteSize x+{-# INLINE prodW64 #-}++-- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1+loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s) -> State# s -> State# s+loop2# n m f = loop' 0# 0#+ where+ loop' i j s | isTrue# (j ==# m) = s+ | isTrue# (i ==# n) = loop' 0# (j +# 1#) s+ | otherwise = case f i j s of s1 -> loop' (i +# 1#) j s1+{-# INLINE loop2# #-}++
+ src-base/Numeric/DataFrame/Inference.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.DataFrame.Inference+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+-- The module provides data types and functions to infer typeclasses at runtime.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Inference+ ( PrimBytesEvidence, inferPrimBytes+ , ElementWiseEvidence, inferElementWise+ , NumericFrameEvidence, inferNumericFrame+ ) where++import Numeric.Array+import Numeric.Array.ElementWise+import Numeric.Commons+import Numeric.DataFrame.Type+import Numeric.Dimensions+++-- | Evidence for PrimBytes class+type PrimBytesEvidence t (ds :: [Nat])+ = Evidence (PrimBytes (DataFrame t ds))++-- | Evidence for ElementWise class+type ElementWiseEvidence t (ds :: [Nat])+ = Evidence (ElementWise (Idx ds) t (DataFrame t ds))++-- | Allow all common operations on available data frames+type NumericFrameEvidence t (ds :: [Nat])+ = Evidence ( NumericFrame t ds)++inferPrimBytes :: forall t (ds :: [Nat])+ . ( ArrayInstanceInference t ds+ , Dimensions ds+ )+ => PrimBytesEvidence t ds+inferPrimBytes = case getArrayInstance @t @ds of+ AIScalar -> case elemTypeInstance @t of+ ETFloat -> Evidence+ ETDouble -> Evidence+ ETInt -> Evidence+ ETInt8 -> Evidence+ ETInt16 -> Evidence+ ETInt32 -> Evidence+ ETInt64 -> Evidence+ ETWord -> Evidence+ ETWord8 -> Evidence+ ETWord16 -> Evidence+ ETWord32 -> Evidence+ ETWord64 -> Evidence+ AIArrayF -> Evidence+ AIArrayD -> Evidence+ AIArrayI -> Evidence+ AIArrayI8 -> Evidence+ AIArrayI16 -> Evidence+ AIArrayI32 -> Evidence+ AIArrayI64 -> Evidence+ AIArrayW -> Evidence+ AIArrayW8 -> Evidence+ AIArrayW16 -> Evidence+ AIArrayW32 -> Evidence+ AIArrayW64 -> Evidence+ AIFloatX2 -> Evidence+ AIFloatX3 -> Evidence+ AIFloatX4 -> Evidence++inferElementWise :: forall t (ds :: [Nat])+ . ( ArrayInstanceInference t ds+ , Dimensions ds+ )+ => ElementWiseEvidence t ds+inferElementWise = case getArrayInstance @t @ds of+ AIScalar -> Evidence+ AIArrayF -> Evidence+ AIArrayD -> Evidence+ AIArrayI -> Evidence+ AIArrayI8 -> Evidence+ AIArrayI16 -> Evidence+ AIArrayI32 -> Evidence+ AIArrayI64 -> Evidence+ AIArrayW -> Evidence+ AIArrayW8 -> Evidence+ AIArrayW16 -> Evidence+ AIArrayW32 -> Evidence+ AIArrayW64 -> Evidence+ AIFloatX2 -> Evidence+ AIFloatX3 -> Evidence+ AIFloatX4 -> Evidence+++inferNumericFrame :: forall t (ds :: [Nat])+ . ( ArrayInstanceInference t ds+ , Dimensions ds+ )+ => NumericFrameEvidence t ds+inferNumericFrame+ | Evidence <- inferDimKnownDims @ds +!+ inferDimFiniteList @ds+ = case getArrayInstance @t @ds of+ AIFloatX2 -> Evidence+ AIFloatX3 -> Evidence+ AIFloatX4 -> Evidence+ AIScalar -> case elemTypeInstance @t of+ ETFloat -> Evidence+ ETDouble -> Evidence+ ETInt -> Evidence+ ETInt8 -> Evidence+ ETInt16 -> Evidence+ ETInt32 -> Evidence+ ETInt64 -> Evidence+ ETWord -> Evidence+ ETWord8 -> Evidence+ ETWord16 -> Evidence+ ETWord32 -> Evidence+ ETWord64 -> Evidence+ AIArrayF -> Evidence+ AIArrayD -> Evidence+ AIArrayI -> Evidence+ AIArrayI8 -> Evidence+ AIArrayI16 -> Evidence+ AIArrayI32 -> Evidence+ AIArrayI64 -> Evidence+ AIArrayW -> Evidence+ AIArrayW8 -> Evidence+ AIArrayW16 -> Evidence+ AIArrayW32 -> Evidence+ AIArrayW64 -> Evidence
+ src-ghcjs/Numeric/Array.hs view
@@ -0,0 +1,18 @@+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+-- Low-level implementations of data frames+--+-----------------------------------------------------------------------------++module Numeric.Array+ ( module Numeric.Array.Family+ ) where++import Numeric.Array.Family+import Numeric.Array.Family.ArrayT ()
+ src-ghcjs/Numeric/Array/Family.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.Array.Family+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+--+-----------------------------------------------------------------------------++module Numeric.Array.Family+ ( Array+ , ArrayT (..), MutableArrayT (..), Scalar (..), Word8Clamped (..)+ , ArrayInstanceInference, ElemType (..), ArraySize (..)+ , ElemTypeInference (..), ArraySizeInference (..), ArrayInstanceEvidence+ , getArrayInstance, ArrayInstance (..), inferArrayInstance+ ) where+++import Data.Int (Int16, Int32, Int8)+import Data.Type.Equality ((:~:) (..))+import Data.Word (Word16, Word32, Word8)+import GHC.Prim (Double#, Float#, Int#,+ Word#, unsafeCoerce#)+import GHC.Types (Int (..))+import GHCJS.Types++import Numeric.Array.ElementWise+import Numeric.Commons+import Numeric.TypeLits+import Numeric.Dimensions++-- | Full collection of n-order arrays+type family Array t (ds :: [Nat]) = v | v -> t ds where+ Array t '[] = Scalar t+ Array t (d ': ds) = ArrayT t (d ': ds)+++-- | Specialize scalar type without any arrays+newtype Scalar t = Scalar { _unScalar :: t }+ deriving ( Bounded, Enum, Eq, Integral+ , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat, IsJSVal)+instance Show t => Show (Scalar t) where+ show (Scalar t) = "{ " ++ show t ++ " }"++++-- | Support for Uint8ClampedArray in JS.+-- This is backed by an ordinary Int type, but clamped to range 0..255 when used in an array+newtype Word8Clamped = Clamped { _fromClamped :: Int } deriving+ (Ord,Num,Eq,Enum,Integral,Real,Show) -- ,Data,Ix,FiniteBits,Bits,Storable)+instance Bounded Word8Clamped where+ maxBound = 255+ {-# INLINE maxBound #-}+ minBound = 0+ {-# INLINE minBound #-}+type instance ElemRep Word8Clamped = ElemRep Int+type instance ElemPrim Word8Clamped = Int#+instance PrimBytes Word8Clamped where+ toBytes (Clamped i) = toBytes (fromIntegral (min 0 (max 255 i)) :: Word8)+ {-# INLINE toBytes #-}+ fromBytes bs = fromIntegral (fromBytes bs :: Word8)+ {-# INLINE fromBytes #-}+ byteSize _ = 1#+ {-# INLINE byteSize #-}+ byteAlign _ = 1#+ {-# INLINE byteAlign #-}+ elementByteSize _ = 1#+ {-# INLINE elementByteSize #-}+ ix _ (Clamped (I# x)) = x+ {-# INLINE ix #-}++instance ElementWise (Idx ('[] :: [Nat])) Word8Clamped Word8Clamped where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-}+ (!) x _ = x+ {-# INLINE (!) #-}+ ewmap f = f Z+ {-# INLINE ewmap #-}+ ewgen f = f Z+ {-# INLINE ewgen #-}+ ewgenA f = f Z+ {-# INLINE ewgenA #-}+ ewfoldl f x0 = f Z x0+ {-# INLINE ewfoldl #-}+ ewfoldr f x0 x = f Z x x0+ {-# INLINE ewfoldr #-}+ elementWise f = f+ {-# INLINE elementWise #-}+ indexWise f = f Z+ {-# INLINE indexWise #-}+ broadcast = id+ {-# INLINE broadcast #-}+ update _ x _ = x+ {-# INLINE update #-}+++type instance ElemRep (Scalar t) = ElemRep t+type instance ElemPrim (Scalar Float ) = Float#+type instance ElemPrim (Scalar Double) = Double#+type instance ElemPrim (Scalar Int ) = Int#+type instance ElemPrim (Scalar Int8 ) = Int#+type instance ElemPrim (Scalar Int16 ) = Int#+type instance ElemPrim (Scalar Int32 ) = Int#+type instance ElemPrim (Scalar Word ) = Word#+type instance ElemPrim (Scalar Word8 ) = Word#+type instance ElemPrim (Scalar Word16) = Word#+type instance ElemPrim (Scalar Word32) = Word#+type instance ElemPrim (Scalar Word8Clamped) = Int#++deriving instance PrimBytes (Scalar Float)+deriving instance PrimBytes (Scalar Double)+deriving instance PrimBytes (Scalar Int)+deriving instance PrimBytes (Scalar Int8)+deriving instance PrimBytes (Scalar Int16)+deriving instance PrimBytes (Scalar Int32)+deriving instance PrimBytes (Scalar Word)+deriving instance PrimBytes (Scalar Word8)+deriving instance PrimBytes (Scalar Word16)+deriving instance PrimBytes (Scalar Word32)+deriving instance PrimBytes (Scalar Word8Clamped)++-- | Indexing over scalars is trivial...+instance ElementWise (Idx ('[] :: [Nat])) t (Scalar t) where+ indexOffset# x _ = _unScalar x+ {-# INLINE indexOffset# #-}+ (!) x _ = _unScalar x+ {-# INLINE (!) #-}+ ewmap f = Scalar . f Z . _unScalar+ {-# INLINE ewmap #-}+ ewgen f = Scalar $ f Z+ {-# INLINE ewgen #-}+ ewgenA f = Scalar <$> f Z+ {-# INLINE ewgenA #-}+ ewfoldl f x0 = f Z x0 . _unScalar+ {-# INLINE ewfoldl #-}+ ewfoldr f x0 x = f Z (_unScalar x) x0+ {-# INLINE ewfoldr #-}+ elementWise f = fmap Scalar . f . _unScalar+ {-# INLINE elementWise #-}+ indexWise f = fmap Scalar . f Z . _unScalar+ {-# INLINE indexWise #-}+ broadcast = Scalar+ {-# INLINE broadcast #-}+ update _ x _ = Scalar x+ {-# INLINE update #-}+++newtype ArrayT t (ds :: [Nat]) = ArrayT JSVal+instance IsJSVal (ArrayT t ds)+newtype MutableArrayT s t (ds :: [Nat]) = MutableArrayT JSVal+instance IsJSVal (MutableArrayT s t ds)+++-- * Recovering type instances at runtime+-- A combination of `ElemType t` and `ArraySize ds` should+-- define an instance of `Array t ds` unambiguously.+++-- | Keep information about the element type instance+--+-- Warning! This part of the code is platform and flag dependent.+data ElemType t+ = t ~ Float => ETFloat+ | t ~ Double => ETDouble+ | t ~ Int => ETInt+ | t ~ Int8 => ETInt8+ | t ~ Int16 => ETInt16+ | t ~ Int32 => ETInt32+ | t ~ Word => ETWord+ | t ~ Word8 => ETWord8+ | t ~ Word16 => ETWord16+ | t ~ Word32 => ETWord32+ | t ~ Word8Clamped => ETWord8C++-- | Keep information about the array dimensionality+--+-- Warning! This part of the code is platform and flag dependent.+data ArraySize (ds :: [Nat])+ = ds ~ '[] => ASScalar+ | forall n ns . ds ~ (n ': ns) => ASArray++-- | Keep information about the instance behind Array family+--+-- Warning! This part of the code is platform and flag dependent.+data ArrayInstance t (ds :: [Nat])+ = ( Array t ds ~ Scalar t, ds ~ '[]) => AIScalar+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Float ) => AIArrayF+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Double) => AIArrayD+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Int ) => AIArrayI+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Int8 ) => AIArrayI8+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Int16 ) => AIArrayI16+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Int32 ) => AIArrayI32+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Word ) => AIArrayW+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Word8 ) => AIArrayW8+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Word16) => AIArrayW16+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Word32) => AIArrayW32+ | forall n ns . ( Array t ds ~ ArrayT t ds, ds ~ (n ': ns), t ~ Word8Clamped) => AIArrayW8C++-- | A singleton type used to prove that the given Array family instance+-- has a known instance+type ArrayInstanceEvidence t (ds :: [Nat])+ = Evidence (ArrayInstanceInference t ds)+++class ElemTypeInference t where+ -- | Pattern match against result to get specific element type+ elemTypeInstance :: ElemType t++class ArraySizeInference ds where+ -- | Pattern match agains result to get actual array dimensionality+ arraySizeInstance :: ArraySize ds+ inferSnocArrayInstance :: (ElemTypeInference t, KnownDim z)+ => p t ds -> q z -> ArrayInstanceEvidence t (ds +: z)+ inferConsArrayInstance :: (ElemTypeInference t, KnownDim z)+ => q z -> p t ds -> ArrayInstanceEvidence t (z :+ ds)+ inferInitArrayInstance :: ElemTypeInference t+ => p t ds -> ArrayInstanceEvidence t (Init ds)+++-- | Use this typeclass constraint in libraries functions if there is a need+-- to select an instance of Array famility at runtime.+-- Combination of `elemTypeInstance` and `arraySizeInstance` allows+-- to bring into typechecker's scope any specific typeclass instance+type ArrayInstanceInference t ds = (ElemTypeInference t, ArraySizeInference ds)++++instance ElemTypeInference Float where+ elemTypeInstance = ETFloat+instance ElemTypeInference Double where+ elemTypeInstance = ETDouble+instance ElemTypeInference Int where+ elemTypeInstance = ETInt+instance ElemTypeInference Int8 where+ elemTypeInstance = ETInt8+instance ElemTypeInference Int16 where+ elemTypeInstance = ETInt16+instance ElemTypeInference Int32 where+ elemTypeInstance = ETInt32+instance ElemTypeInference Word where+ elemTypeInstance = ETWord+instance ElemTypeInference Word8 where+ elemTypeInstance = ETWord8+instance ElemTypeInference Word16 where+ elemTypeInstance = ETWord16+instance ElemTypeInference Word32 where+ elemTypeInstance = ETWord32+instance ElemTypeInference Word8Clamped where+ elemTypeInstance = ETWord8C++instance ArraySizeInference '[] where+ arraySizeInstance = ASScalar+ {-# INLINE arraySizeInstance #-}+ inferSnocArrayInstance _ _ = Evidence+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ inferInitArrayInstance _ = error "Init -- empty type-level list"+ {-# INLINE inferInitArrayInstance #-}++instance KnownDim d => ArraySizeInference '[d] where+ arraySizeInstance = case dimVal' @d of+ 0 -> unsafeCoerce# ASScalar+ 1 -> unsafeCoerce# ASScalar+ _ -> case (unsafeCoerce# Refl :: (5 <=? d) :~: 'True) of Refl -> ASArray+ {-# INLINE arraySizeInstance #-}+ inferSnocArrayInstance _ _ = Evidence+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ inferInitArrayInstance _ = Evidence+ {-# INLINE inferInitArrayInstance #-}+++instance ArraySizeInference (d1 ': d2 ': ds) where+ arraySizeInstance = ASArray+ {-# INLINE arraySizeInstance #-}+ -- I know that for dimensionality > 2 all instances are the same.+ -- Hence this dirty hack should work.+ -- I have to change this when I have customized N*M instances+ inferSnocArrayInstance p q = unsafeCoerce# (inferConsArrayInstance q p)+ {-# INLINE inferSnocArrayInstance #-}+ inferConsArrayInstance _ _ = Evidence+ {-# INLINE inferConsArrayInstance #-}+ -- I know that for dimensionality > 2 all instances are the same.+ -- Hence this dirty hack should work.+ -- I have to change this when I have customized N*M instances+ inferInitArrayInstance p = unsafeCoerce# (inferConsArrayInstance (Proxy @3) p)+ {-# INLINE inferInitArrayInstance #-}++++getArrayInstance :: forall t (ds :: [Nat])+ . ArrayInstanceInference t ds+ => ArrayInstance t ds+getArrayInstance = case (elemTypeInstance @t, arraySizeInstance @ds) of+ (_ , ASScalar) -> AIScalar++ (ETFloat , ASArray) -> AIArrayF+ (ETDouble , ASArray) -> AIArrayD+ (ETInt , ASArray) -> AIArrayI+ (ETInt8 , ASArray) -> AIArrayI8+ (ETInt16 , ASArray) -> AIArrayI16+ (ETInt32 , ASArray) -> AIArrayI32+ (ETWord , ASArray) -> AIArrayW+ (ETWord8 , ASArray) -> AIArrayW8+ (ETWord16 , ASArray) -> AIArrayW16+ (ETWord32 , ASArray) -> AIArrayW32+ (ETWord8C , ASArray) -> AIArrayW8C++-- | Given element type instance and proper dimension list,+-- infer a corresponding array instance+inferArrayInstance :: forall t ds+ . ( FiniteList ds+ , KnownDims ds+ , ElemTypeInference t+ )+ => ArrayInstanceEvidence t ds+inferArrayInstance = case tList @_ @ds of+ TLEmpty -> Evidence+ TLCons _ TLEmpty -> Evidence+ TLCons _ (TLCons _ TLEmpty) -> Evidence+ TLCons _ (TLCons _ (TLCons _ _)) -> Evidence+++_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)+_suppressHlintUnboxedTuplesWarning = undefined
+ src-ghcjs/Numeric/Array/Family/ArrayT.hs view
@@ -0,0 +1,1642 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+-- {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE JavaScriptFFI #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE Strict #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Numeric.Array.Family.ArrayT () where+++import GHC.Base (runRW#)+import GHC.Int (Int16 (..), Int32 (..), Int8 (..))+import GHC.Word (Word16 (..), Word32 (..), Word8 (..))+import GHC.Prim+import GHC.Types (Float (..), Double (..), Int (..), Word (..))+--import GHCJS.Types++import Numeric.Array.ElementWise+import Numeric.Array.Family+import Numeric.Commons+import Numeric.DataFrame.Type+import Numeric.Dimensions+import Numeric.Dimensions.Traverse+import Numeric.TypeLits+import Numeric.Matrix.Type+++type instance ElemRep (ArrayT t ds) = ElemRep t+type instance ElemPrim (ArrayT Float ds) = Float#+type instance ElemPrim (ArrayT Double ds) = Double#+type instance ElemPrim (ArrayT Int ds) = Int#+type instance ElemPrim (ArrayT Int8 ds) = Int#+type instance ElemPrim (ArrayT Int16 ds) = Int#+type instance ElemPrim (ArrayT Int32 ds) = Int#+type instance ElemPrim (ArrayT Word ds) = Word#+type instance ElemPrim (ArrayT Word8 ds) = Word#+type instance ElemPrim (ArrayT Word16 ds) = Word#+type instance ElemPrim (ArrayT Word32 ds) = Word#+type instance ElemPrim (ArrayT Word8Clamped ds) = Int#+++instance Dimensions ds => PrimBytes (ArrayT Float ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapFloatArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Float)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Float)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Float)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetFloat#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Double ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapDoubleArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Double)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Double)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Double)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetDouble#+ {-# INLINE ix #-}+++instance Dimensions ds => PrimBytes (ArrayT Int ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapIntArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Int)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Int)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Int)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetInt#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Int8 ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapInt8ArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Int8)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Int8)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Int8)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetInt8#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Int16 ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapInt16ArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Int16)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Int16)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Int16)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetInt16#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Int32 ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapInt32ArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Int32)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Int32)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Int32)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetInt32#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Word ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapWordArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Word)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Word)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Word)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetWord#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Word8 ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapWord8ArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Word8)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Word8)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Word8)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetWord8#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Word8Clamped ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapWord8ClampedArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Word8Clamped)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Word8Clamped)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Word8Clamped)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetWord8Clamped#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Word16 ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapWord16ArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Word16)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Word16)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Word16)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetWord16#+ {-# INLINE ix #-}++instance Dimensions ds => PrimBytes (ArrayT Word32 ds) where+ toBytes v = (# js_byteOffset v `quotInt#` elementByteSize v , js_length v , js_wrapArrayT v #)+ {-# INLINE toBytes #-}+ fromBytes (# off, len, arr #) = js_unwrapWord32ArrayOffLen arr off len+ {-# INLINE fromBytes #-}+ byteSize ~_ = case totalDim (dim @ds) of I# n -> n *# byteSize (undefined :: Word32)+ {-# INLINE byteSize #-}+ byteAlign ~_ = byteAlign (undefined :: Word32)+ {-# INLINE byteAlign #-}+ elementByteSize ~_ = byteSize (undefined :: Word32)+ {-# INLINE elementByteSize #-}+ ix = js_indexArrayOffsetWord32#+ {-# INLINE ix #-}+++++instance ( Dimensions ds+ , Show t+ , ElementWise (Idx ds) t (ArrayT t ds)+ )+ => Show (ArrayT t (ds :: [Nat])) where+ show x = case dim @ds of+ D -> "{ " ++ show (x ! Z) ++ " }"+ Dn :* D -> ('{' :) . drop 1 $+ foldr (\i s -> ", " ++ show (x ! i) ++ s) " }"+ [minBound .. maxBound]+ (Dn :: Dim (n :: Nat)) :* (Dn :: Dim (m :: Nat)) :* (_ :: Dim (dss :: [Nat])) ->+ case inferDropNDimensions @2 @ds of+ Evidence ->+ let loopInner :: Idx dss -> Idx '[n,m] -> String+ loopInner ods (n:!m:!_) = ('{' :) . drop 2 $+ foldr (\i ss -> '\n':+ foldr (\j s ->+ ", " ++ show (x ! (i :! j :! ods)) ++ s+ ) ss [1..m]+ ) " }" [1..n]+ loopOuter :: Idx dss -> String -> String+ loopOuter Z s = "\n" ++ loopInner Z maxBound ++ s+ loopOuter ds s = "\n(i j" ++ drop 3 (show ds) ++ "):\n"+ ++ loopInner ds maxBound ++ s+ in drop 1 $ foldr loopOuter "" [minBound..maxBound]+++instance Eq (ArrayT t ds) where+ (==) = js_arrayTEq+ (/=) = js_arrayTNEq+foreign import javascript unsafe "$1.every(function (e, i) { return e == $2[i]; })" js_arrayTEq :: ArrayT t ds -> ArrayT t ds -> Bool+foreign import javascript unsafe "$1.some(function (e, i) { return e !== $2[i]; })" js_arrayTNEq :: ArrayT t ds -> ArrayT t ds -> Bool+++++instance Ord (ArrayT t ds) where+ (<) = js_arrayTLT+ (<=) = js_arrayTLE+ (>) = js_arrayTGT+ (>=) = js_arrayTGE+ compare a b = case js_arrayTCmp a b of+ 1 -> GT+ 0 -> EQ+ _ -> LT+foreign import javascript unsafe "$1.every(function (e, i) { return e < $2[i]; })" js_arrayTLT :: ArrayT t ds -> ArrayT t ds -> Bool+foreign import javascript unsafe "$1.every(function (e, i) { return e <= $2[i]; })" js_arrayTLE :: ArrayT t ds -> ArrayT t ds -> Bool+foreign import javascript unsafe "$1.every(function (e, i) { return e > $2[i]; })" js_arrayTGT :: ArrayT t ds -> ArrayT t ds -> Bool+foreign import javascript unsafe "$1.every(function (e, i) { return e >= $2[i]; })" js_arrayTGE :: ArrayT t ds -> ArrayT t ds -> Bool+foreign import javascript unsafe "$1.reduce(function (r, e, i) { return r === 0 ? (e > $2[i] ? 1 : (e < $2[i] ? -1 : 0)) : r;}, 0)" js_arrayTCmp :: ArrayT t ds -> ArrayT t ds -> Int+++instance Dimensions ds => Num (ArrayT Float ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewFloatArray (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Double ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewDoubleArray (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Int ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewIntArray (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Int8 ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewInt8Array (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Int16 ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewInt16Array (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Int32 ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewInt32Array (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Word ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewWordArray (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Word8 ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewWord8Array (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Word16 ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewWord16Array (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Word32 ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewWord32Array (totalDim (dim @ds)) . fromInteger+instance Dimensions ds => Num (ArrayT Word8Clamped ds) where+ (+) = js_arrayTPlus+ (-) = js_arrayTMinus+ (*) = js_arrayTTimes+ negate = js_arrayTNegate+ abs = js_arrayTAbs+ signum = js_arrayTSignum+ fromInteger = js_fillNewWord8ClampedArray (totalDim (dim @ds)) . fromInteger++foreign import javascript unsafe "$1.map(function (e, i) { return e + $2[i]; })" js_arrayTPlus :: ArrayT t ds -> ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e, i) { return e - $2[i]; })" js_arrayTMinus :: ArrayT t ds -> ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e, i) { return e * $2[i]; })" js_arrayTTimes :: ArrayT t ds -> ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return -e; })" js_arrayTNegate :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.abs(e); })" js_arrayTAbs :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.sign(e); })" js_arrayTSignum :: ArrayT t ds -> ArrayT t ds++++instance Dimensions ds => Fractional (ArrayT Float ds) where+ recip = js_arrayTRecip+ (/) = js_arrayTDivide+ fromRational = js_fillNewFloatArray (totalDim (dim @ds)) . fromRational+instance Dimensions ds => Fractional (ArrayT Double ds) where+ recip = js_arrayTRecip+ (/) = js_arrayTDivide+ fromRational = js_fillNewDoubleArray (totalDim (dim @ds)) . fromRational++foreign import javascript unsafe "$1.map(function (e, i) { return e/$2[i]; })" js_arrayTDivide :: ArrayT t ds -> ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return 1/e; })" js_arrayTRecip :: ArrayT t ds -> ArrayT t ds+++instance Dimensions ds => Floating (ArrayT Float ds) where+ pi = broadcast pi+ {-# INLINE pi #-}+ exp = js_arrayTexp+ {-# INLINE exp #-}+ log = js_arrayTlog+ {-# INLINE log #-}+ sqrt = js_arrayTsqrt+ {-# INLINE sqrt #-}+ sin = js_arrayTsin+ {-# INLINE sin #-}+ cos = js_arrayTcos+ {-# INLINE cos #-}+ tan = js_arrayTtan+ {-# INLINE tan #-}+ asin = js_arrayTasin+ {-# INLINE asin #-}+ acos = js_arrayTacos+ {-# INLINE acos #-}+ atan = js_arrayTatan+ {-# INLINE atan #-}+ sinh = js_arrayTsinh+ {-# INLINE sinh #-}+ cosh = js_arrayTcosh+ {-# INLINE cosh #-}+ tanh = js_arrayTtanh+ {-# INLINE tanh #-}+ (**) = js_arrayTpower+ {-# INLINE (**) #-}+ logBase = js_arrayTlogBase+ {-# INLINE logBase #-}+ asinh = js_arrayTasinh+ {-# INLINE asinh #-}+ acosh = js_arrayTacosh+ {-# INLINE acosh #-}+ atanh = js_arrayTatanh+ {-# INLINE atanh #-}++instance Dimensions ds => Floating (ArrayT Double ds) where+ pi = broadcast pi+ {-# INLINE pi #-}+ exp = js_arrayTexp+ {-# INLINE exp #-}+ log = js_arrayTlog+ {-# INLINE log #-}+ sqrt = js_arrayTsqrt+ {-# INLINE sqrt #-}+ sin = js_arrayTsin+ {-# INLINE sin #-}+ cos = js_arrayTcos+ {-# INLINE cos #-}+ tan = js_arrayTtan+ {-# INLINE tan #-}+ asin = js_arrayTasin+ {-# INLINE asin #-}+ acos = js_arrayTacos+ {-# INLINE acos #-}+ atan = js_arrayTatan+ {-# INLINE atan #-}+ sinh = js_arrayTsinh+ {-# INLINE sinh #-}+ cosh = js_arrayTcosh+ {-# INLINE cosh #-}+ tanh = js_arrayTtanh+ {-# INLINE tanh #-}+ (**) = js_arrayTpower+ {-# INLINE (**) #-}+ logBase = js_arrayTlogBase+ {-# INLINE logBase #-}+ asinh = js_arrayTasinh+ {-# INLINE asinh #-}+ acosh = js_arrayTacosh+ {-# INLINE acosh #-}+ atanh = js_arrayTatanh+ {-# INLINE atanh #-}+++foreign import javascript unsafe "$1.map(function (e) { return Math.exp(e); })" js_arrayTexp :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.log(e); })" js_arrayTlog :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.sqrt(e); })" js_arrayTsqrt :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.sin(e); })" js_arrayTsin :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.cos(e); })" js_arrayTcos :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.tan(e); })" js_arrayTtan :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.asin(e); })" js_arrayTasin :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.acos(e); })" js_arrayTacos :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.atan(e); })" js_arrayTatan :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.sinh(e); })" js_arrayTsinh :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.cosh(e); })" js_arrayTcosh :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.tanh(e); })" js_arrayTtanh :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.asinh(e); })" js_arrayTasinh :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.acosh(e); })" js_arrayTacosh :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e) { return Math.atanh(e); })" js_arrayTatanh :: ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e,i) { return Math.log($2[i])/Math.log(e); })" js_arrayTlogBase :: ArrayT t ds -> ArrayT t ds -> ArrayT t ds+foreign import javascript unsafe "$1.map(function (e,i) { return Math.pow(e,$2[i]); })" js_arrayTpower :: ArrayT t ds -> ArrayT t ds -> ArrayT t ds++++instance Dimensions ds => Bounded (ArrayT Int ds) where+ maxBound = js_fillNewIntArray (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewIntArray (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Int8 ds) where+ maxBound = js_fillNewInt8Array (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewInt8Array (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Int16 ds) where+ maxBound = js_fillNewInt16Array (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewInt16Array (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Int32 ds) where+ maxBound = js_fillNewInt32Array (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewInt32Array (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Word ds) where+ maxBound = js_fillNewWordArray (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewWordArray (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Word8 ds) where+ maxBound = js_fillNewWord8Array (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewWord8Array (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Word16 ds) where+ maxBound = js_fillNewWord16Array (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewWord16Array (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Word32 ds) where+ maxBound = js_fillNewWord32Array (totalDim (dim @ds)) maxBound+ {-# INLINE maxBound #-}+ minBound = js_fillNewWord32Array (totalDim (dim @ds)) minBound+ {-# INLINE minBound #-}+instance Dimensions ds => Bounded (ArrayT Word8Clamped ds) where+ maxBound = js_fillNewWord8ClampedArray (totalDim (dim @ds)) 255+ {-# INLINE maxBound #-}+ minBound = js_fillNewWord8ClampedArray (totalDim (dim @ds)) 0+ {-# INLINE minBound #-}+++++++wr :: (State# RealWorld -> (# State# RealWorld, MutableArrayT RealWorld t ds #) )+ -> (MutableArrayT RealWorld t ds -> State# RealWorld -> State# RealWorld)+ -> ArrayT t ds+wr fma ff = case runRW#+ ( \s0 -> case fma s0 of+ (# s1, ma #) -> case ff ma s1 of s2 -> unsafeFreezeArrayT# ma s2+ ) of (# _, r #) -> r+{-# INLINE wr #-}++++instance Dimensions ds => ElementWise (Idx ds) Float (ArrayT Float ds) where+ indexOffset# x i = js_indexArrayOffsetFloat i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetFloat j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewFloatArray (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (F# v) = case fromEnum i of I# j -> js_setArrayOffsetFloat# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createFloatArray (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetFloat off x) of+ (F# r) -> js_writeArrayOffsetFloat# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createFloatArray n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (F# r) -> js_writeArrayOffsetFloat# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createFloatArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(F# z) u a s -> js_writeArrayOffsetFloat# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetFloat off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetFloat off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createFloatArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(F# z) u a s -> js_writeArrayOffsetFloat# off z a (u a s) ) <$> f i (js_indexArrayOffsetFloat off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createFloatArray n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(F# z) u a s -> js_writeArrayOffsetFloat# off z a (u a s) ) <$> f (js_indexArrayOffsetFloat off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++instance Dimensions ds => ElementWise (Idx ds) Double (ArrayT Double ds) where+ indexOffset# x i = js_indexArrayOffsetDouble i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetDouble j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewDoubleArray (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (D# v) = case fromEnum i of I# j -> js_setArrayOffsetDouble# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createDoubleArray (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetDouble off x) of+ (D# r) -> js_writeArrayOffsetDouble# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createDoubleArray n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (D# r) -> js_writeArrayOffsetDouble# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createDoubleArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(D# z) u a s -> js_writeArrayOffsetDouble# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetDouble off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetDouble off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createDoubleArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(D# z) u a s -> js_writeArrayOffsetDouble# off z a (u a s) ) <$> f i (js_indexArrayOffsetDouble off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createDoubleArray n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(D# z) u a s -> js_writeArrayOffsetDouble# off z a (u a s) ) <$> f (js_indexArrayOffsetDouble off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++instance Dimensions ds => ElementWise (Idx ds) Int32 (ArrayT Int32 ds) where+ indexOffset# x i = js_indexArrayOffsetInt32 i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetInt32 j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewInt32Array (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (I32# v) = case fromEnum i of I# j -> js_setArrayOffsetInt32# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createInt32Array (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetInt32 off x) of+ (I32# r) -> js_writeArrayOffsetInt32# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createInt32Array n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (I32# r) -> js_writeArrayOffsetInt32# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createInt32Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I32# z) u a s -> js_writeArrayOffsetInt32# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetInt32 off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetInt32 off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createInt32Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I32# z) u a s -> js_writeArrayOffsetInt32# off z a (u a s) ) <$> f i (js_indexArrayOffsetInt32 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createInt32Array n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(I32# z) u a s -> js_writeArrayOffsetInt32# off z a (u a s) ) <$> f (js_indexArrayOffsetInt32 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++instance Dimensions ds => ElementWise (Idx ds) Int16 (ArrayT Int16 ds) where+ indexOffset# x i = js_indexArrayOffsetInt16 i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetInt16 j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewInt16Array (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (I16# v) = case fromEnum i of I# j -> js_setArrayOffsetInt16# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createInt16Array (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetInt16 off x) of+ (I16# r) -> js_writeArrayOffsetInt16# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createInt16Array n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (I16# r) -> js_writeArrayOffsetInt16# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createInt16Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I16# z) u a s -> js_writeArrayOffsetInt16# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetInt16 off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetInt16 off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createInt16Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I16# z) u a s -> js_writeArrayOffsetInt16# off z a (u a s) ) <$> f i (js_indexArrayOffsetInt16 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createInt16Array n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(I16# z) u a s -> js_writeArrayOffsetInt16# off z a (u a s) ) <$> f (js_indexArrayOffsetInt16 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++instance Dimensions ds => ElementWise (Idx ds) Int8 (ArrayT Int8 ds) where+ indexOffset# x i = js_indexArrayOffsetInt8 i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetInt8 j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewInt8Array (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (I8# v) = case fromEnum i of I# j -> js_setArrayOffsetInt8# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createInt8Array (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetInt8 off x) of+ (I8# r) -> js_writeArrayOffsetInt8# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createInt8Array n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (I8# r) -> js_writeArrayOffsetInt8# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createInt8Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I8# z) u a s -> js_writeArrayOffsetInt8# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetInt8 off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetInt8 off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createInt8Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I8# z) u a s -> js_writeArrayOffsetInt8# off z a (u a s) ) <$> f i (js_indexArrayOffsetInt8 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createInt8Array n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(I8# z) u a s -> js_writeArrayOffsetInt8# off z a (u a s) ) <$> f (js_indexArrayOffsetInt8 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++instance Dimensions ds => ElementWise (Idx ds) Int (ArrayT Int ds) where+ indexOffset# x i = js_indexArrayOffsetInt i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetInt j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewIntArray (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (I# v) = case fromEnum i of I# j -> js_setArrayOffsetInt# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createIntArray (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetInt off x) of+ (I# r) -> js_writeArrayOffsetInt# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createIntArray n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (I# r) -> js_writeArrayOffsetInt# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createIntArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I# z) u a s -> js_writeArrayOffsetInt# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetInt off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetInt off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createIntArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(I# z) u a s -> js_writeArrayOffsetInt# off z a (u a s) ) <$> f i (js_indexArrayOffsetInt off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createIntArray n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(I# z) u a s -> js_writeArrayOffsetInt# off z a (u a s) ) <$> f (js_indexArrayOffsetInt off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++++instance Dimensions ds => ElementWise (Idx ds) Word32 (ArrayT Word32 ds) where+ indexOffset# x i = js_indexArrayOffsetWord32 i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetWord32 j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewWord32Array (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (W32# v) = case fromEnum i of I# j -> js_setArrayOffsetWord32# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createWord32Array (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetWord32 off x) of+ (W32# r) -> js_writeArrayOffsetWord32# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createWord32Array n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (W32# r) -> js_writeArrayOffsetWord32# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createWord32Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W32# z) u a s -> js_writeArrayOffsetWord32# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetWord32 off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetWord32 off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createWord32Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W32# z) u a s -> js_writeArrayOffsetWord32# off z a (u a s) ) <$> f i (js_indexArrayOffsetWord32 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createWord32Array n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(W32# z) u a s -> js_writeArrayOffsetWord32# off z a (u a s) ) <$> f (js_indexArrayOffsetWord32 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++instance Dimensions ds => ElementWise (Idx ds) Word16 (ArrayT Word16 ds) where+ indexOffset# x i = js_indexArrayOffsetWord16 i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetWord16 j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewWord16Array (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (W16# v) = case fromEnum i of I# j -> js_setArrayOffsetWord16# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createWord16Array (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetWord16 off x) of+ (W16# r) -> js_writeArrayOffsetWord16# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createWord16Array n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (W16# r) -> js_writeArrayOffsetWord16# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createWord16Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W16# z) u a s -> js_writeArrayOffsetWord16# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetWord16 off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetWord16 off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createWord16Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W16# z) u a s -> js_writeArrayOffsetWord16# off z a (u a s) ) <$> f i (js_indexArrayOffsetWord16 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createWord16Array n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(W16# z) u a s -> js_writeArrayOffsetWord16# off z a (u a s) ) <$> f (js_indexArrayOffsetWord16 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++instance Dimensions ds => ElementWise (Idx ds) Word8 (ArrayT Word8 ds) where+ indexOffset# x i = js_indexArrayOffsetWord8 i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetWord8 j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewWord8Array (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (W8# v) = case fromEnum i of I# j -> js_setArrayOffsetWord8# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createWord8Array (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetWord8 off x) of+ (W8# r) -> js_writeArrayOffsetWord8# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createWord8Array n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (W8# r) -> js_writeArrayOffsetWord8# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createWord8Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W8# z) u a s -> js_writeArrayOffsetWord8# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetWord8 off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetWord8 off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createWord8Array n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W8# z) u a s -> js_writeArrayOffsetWord8# off z a (u a s) ) <$> f i (js_indexArrayOffsetWord8 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createWord8Array n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(W8# z) u a s -> js_writeArrayOffsetWord8# off z a (u a s) ) <$> f (js_indexArrayOffsetWord8 off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++instance Dimensions ds => ElementWise (Idx ds) Word (ArrayT Word ds) where+ indexOffset# x i = js_indexArrayOffsetWord i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetWord j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewWordArray (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (W# v) = case fromEnum i of I# j -> js_setArrayOffsetWord# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createWordArray (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetWord off x) of+ (W# r) -> js_writeArrayOffsetWord# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createWordArray n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (W# r) -> js_writeArrayOffsetWord# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createWordArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W# z) u a s -> js_writeArrayOffsetWord# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetWord off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetWord off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createWordArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(W# z) u a s -> js_writeArrayOffsetWord# off z a (u a s) ) <$> f i (js_indexArrayOffsetWord off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createWordArray n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(W# z) u a s -> js_writeArrayOffsetWord# off z a (u a s) ) <$> f (js_indexArrayOffsetWord off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds+++++instance Dimensions ds => ElementWise (Idx ds) Word8Clamped (ArrayT Word8Clamped ds) where+ indexOffset# x i = js_indexArrayOffsetWord8Clamped i x+ {-# INLINE indexOffset# #-}+ x ! i = case fromEnum i of I# j -> js_indexArrayOffsetWord8Clamped j x+ {-# INLINE (!) #-}+ broadcast = js_fillNewWord8ClampedArray (totalDim (dim @ds))+ {-# INLINE broadcast #-}+ update i (Clamped (I# v)) = case fromEnum i of I# j -> js_setArrayOffsetWord8Clamped# j v+ {-# INLINE update #-}++ ewmap f x = case runRW#+ (\s0 -> case js_createWord8ClampedArray (js_length x) s0 of+ (# s1, my #) -> case overDim_# (dim `inSpaceOf` x)+ ( \ii off -> case f ii (js_indexArrayOffsetWord8Clamped off x) of+ (Clamped (I# r)) -> js_writeArrayOffsetWord8Clamped# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ {-# INLINE ewmap #-}++ ewgen f = case runRW#+ (\s0 -> case js_createWord8ClampedArray n s0 of+ (# s1, my #) -> case overDim_# dds+ ( \ii off -> case f ii of+ (Clamped (I# r)) -> js_writeArrayOffsetWord8Clamped# off r my+ ) 0# 1# s1 of+ s3 -> unsafeFreezeArrayT# my s3+ ) of (# _, r #) -> r+ where+ dds = dim @ds+ n = case totalDim dds of I# d -> d+ {-# INLINE ewgen #-}++ ewgenA f = wr (js_createWord8ClampedArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(Clamped (I# z)) u a s -> js_writeArrayOffsetWord8Clamped# off z a (u a s) ) <$> f i <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ ewfoldr f v0 x+ = foldDimReverse (dim `inSpaceOf` x)+ (\ii off a -> f ii (js_indexArrayOffsetWord8Clamped off x) a) 0# 1# v0+ {-# INLINE ewfoldr #-}++ ewfoldl f v0 x+ = foldDim (dim `inSpaceOf` x)+ (\ii off a -> f ii a (js_indexArrayOffsetWord8Clamped off x)) 0# 1# v0+ {-# INLINE ewfoldl #-}++ indexWise f x = wr (js_createWord8ClampedArray n) <$> foldDim dds g 0# 1# (pure (\_ s -> s))+ where+ g i off mf = (\(Clamped (I# z)) u a s -> js_writeArrayOffsetWord8Clamped# off z a (u a s) ) <$> f i (js_indexArrayOffsetWord8Clamped off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++ elementWise f x = wr (js_createWord8ClampedArray n) <$> foldDimOff dds g 0# 1# (pure (\_ s -> s))+ where+ g off mf = (\(Clamped (I# z)) u a s -> js_writeArrayOffsetWord8Clamped# off z a (u a s) ) <$> f (js_indexArrayOffsetWord8Clamped off x) <*> mf+ n = case totalDim dds of I# d -> d+ dds = dim @ds++++++++instance (KnownDim n, KnownDim m, ArrayT t '[n,m] ~ Array t '[n,m], 2 <= n, 2 <= m)+ => MatrixCalculus t n m where+ transpose = KnownDataFrame . js_transpose @t @n @m (dimVal' @n) . _getDF++foreign import javascript unsafe "h$easytensor_transpose($1, $2)" js_transpose :: Int -> ArrayT t '[n,m] -> ArrayT t '[m,n]+++instance ( KnownDim n, ArrayT Float '[n,n] ~ Array Float '[n,n] )+ => SquareMatrixCalculus Float n where+ eye = KnownDataFrame $ js_eyeFloat (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagFloat (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceFloat m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detFloat m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Double '[n,n] ~ Array Double '[n,n] )+ => SquareMatrixCalculus Double n where+ eye = KnownDataFrame $ js_eyeDouble (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagDouble (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceDouble m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detDouble m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Int '[n,n] ~ Array Int '[n,n] )+ => SquareMatrixCalculus Int n where+ eye = KnownDataFrame $ js_eyeInt (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagInt (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceInt m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detInt m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Int8 '[n,n] ~ Array Int8 '[n,n] )+ => SquareMatrixCalculus Int8 n where+ eye = KnownDataFrame $ js_eyeInt8 (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagInt8 (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceInt8 m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detInt8 m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Int16 '[n,n] ~ Array Int16 '[n,n] )+ => SquareMatrixCalculus Int16 n where+ eye = KnownDataFrame $ js_eyeInt16 (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagInt16 (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceInt16 m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detInt16 m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Int32 '[n,n] ~ Array Int32 '[n,n] )+ => SquareMatrixCalculus Int32 n where+ eye = KnownDataFrame $ js_eyeInt32 (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagInt32 (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceInt32 m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detInt32 m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Word '[n,n] ~ Array Word '[n,n] )+ => SquareMatrixCalculus Word n where+ eye = KnownDataFrame $ js_eyeWord (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagWord (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceWord m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detWord m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Word8 '[n,n] ~ Array Word8 '[n,n] )+ => SquareMatrixCalculus Word8 n where+ eye = KnownDataFrame $ js_eyeWord8 (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagWord8 (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceWord8 m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detWord8 m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Word16 '[n,n] ~ Array Word16 '[n,n] )+ => SquareMatrixCalculus Word16 n where+ eye = KnownDataFrame $ js_eyeWord16 (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagWord16 (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceWord16 m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detWord16 m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Word32 '[n,n] ~ Array Word32 '[n,n] )+ => SquareMatrixCalculus Word32 n where+ eye = KnownDataFrame $ js_eyeWord32 (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagWord32 (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceWord32 m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detWord32 m (dimVal' @n)+ {-# INLINE det #-}++instance ( KnownDim n, ArrayT Word8Clamped '[n,n] ~ Array Word8Clamped '[n,n] )+ => SquareMatrixCalculus Word8Clamped n where+ eye = KnownDataFrame $ js_eyeWord8Clamped (dimVal' @n)+ {-# INLINE eye #-}+ diag (KnownDataFrame (Scalar x)) = KnownDataFrame $ js_diagWord8Clamped (dimVal' @n) x+ {-# INLINE diag #-}+ trace (KnownDataFrame m) = KnownDataFrame . Scalar $ js_traceWord8Clamped m (dimVal' @n)+ {-# INLINE trace #-}+ det (KnownDataFrame m) = KnownDataFrame . Scalar $ js_detWord8Clamped m (dimVal' @n)+ {-# INLINE det #-}++foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detFloat :: ArrayT Float '[n,n] -> Int -> Float+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detDouble :: ArrayT Double '[n,n] -> Int -> Double+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detInt :: ArrayT Int '[n,n] -> Int -> Int+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detInt8 :: ArrayT Int8 '[n,n] -> Int -> Int8+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detInt16 :: ArrayT Int16 '[n,n] -> Int -> Int16+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detInt32 :: ArrayT Int32 '[n,n] -> Int -> Int32+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detWord :: ArrayT Word '[n,n] -> Int -> Word+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detWord8 :: ArrayT Word8 '[n,n] -> Int -> Word8+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detWord16 :: ArrayT Word16 '[n,n] -> Int -> Word16+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detWord32 :: ArrayT Word32 '[n,n] -> Int -> Word32+foreign import javascript unsafe "h$easytensor_det($1, $2)" js_detWord8Clamped :: ArrayT Word8Clamped '[n,n] -> Int -> Word8Clamped++foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceFloat :: ArrayT Float '[n,n] -> Int -> Float+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceDouble :: ArrayT Double '[n,n] -> Int -> Double+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceInt :: ArrayT Int '[n,n] -> Int -> Int+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceInt8 :: ArrayT Int8 '[n,n] -> Int -> Int8+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceInt16 :: ArrayT Int16 '[n,n] -> Int -> Int16+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceInt32 :: ArrayT Int32 '[n,n] -> Int -> Int32+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceWord :: ArrayT Word '[n,n] -> Int -> Word+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceWord8 :: ArrayT Word8 '[n,n] -> Int -> Word8+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceWord16 :: ArrayT Word16 '[n,n] -> Int -> Word16+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceWord32 :: ArrayT Word32 '[n,n] -> Int -> Word32+foreign import javascript unsafe "h$easytensor_trace($1, $2)" js_traceWord8Clamped :: ArrayT Word8Clamped '[n,n] -> Int -> Word8Clamped+++foreign import javascript unsafe "h$easytensor_diagFloat32($1, $2)" js_diagFloat :: Int -> Float -> ArrayT Float '[n,n]+foreign import javascript unsafe "h$easytensor_diagFloat64($1, $2)" js_diagDouble :: Int -> Double -> ArrayT Double '[n,n]+foreign import javascript unsafe "h$easytensor_diagInt32($1, $2)" js_diagInt :: Int -> Int -> ArrayT Int '[n,n]+foreign import javascript unsafe "h$easytensor_diagInt8($1, $2)" js_diagInt8 :: Int -> Int8 -> ArrayT Int8 '[n,n]+foreign import javascript unsafe "h$easytensor_diagInt16($1, $2)" js_diagInt16 :: Int -> Int16 -> ArrayT Int16 '[n,n]+foreign import javascript unsafe "h$easytensor_diagInt32($1, $2)" js_diagInt32 :: Int -> Int32 -> ArrayT Int32 '[n,n]+foreign import javascript unsafe "h$easytensor_diagUint($1, $2)" js_diagWord :: Int -> Word -> ArrayT Word '[n,n]+foreign import javascript unsafe "h$easytensor_diagUint8($1, $2)" js_diagWord8 :: Int -> Word8 -> ArrayT Word8 '[n,n]+foreign import javascript unsafe "h$easytensor_diagUint16($1, $2)" js_diagWord16 :: Int -> Word16 -> ArrayT Word16 '[n,n]+foreign import javascript unsafe "h$easytensor_diagUint32($1, $2)" js_diagWord32 :: Int -> Word32 -> ArrayT Word32 '[n,n]+foreign import javascript unsafe "h$easytensor_diagUint8Clamped($1, $2)" js_diagWord8Clamped :: Int -> Word8Clamped ->ArrayT Word8Clamped '[n,n]+++foreign import javascript unsafe "h$easytensor_eyeFloat32($1)" js_eyeFloat :: Int -> ArrayT Float '[n,n]+foreign import javascript unsafe "h$easytensor_eyeFloat64($1)" js_eyeDouble :: Int -> ArrayT Double '[n,n]+foreign import javascript unsafe "h$easytensor_eyeInt32($1)" js_eyeInt :: Int -> ArrayT Int '[n,n]+foreign import javascript unsafe "h$easytensor_eyeInt8($1)" js_eyeInt8 :: Int -> ArrayT Int8 '[n,n]+foreign import javascript unsafe "h$easytensor_eyeInt16($1)" js_eyeInt16 :: Int -> ArrayT Int16 '[n,n]+foreign import javascript unsafe "h$easytensor_eyeInt32($1)" js_eyeInt32 :: Int -> ArrayT Int32 '[n,n]+foreign import javascript unsafe "h$easytensor_eyeUint($1)" js_eyeWord :: Int -> ArrayT Word '[n,n]+foreign import javascript unsafe "h$easytensor_eyeUint8($1)" js_eyeWord8 :: Int -> ArrayT Word8 '[n,n]+foreign import javascript unsafe "h$easytensor_eyeUint16($1)" js_eyeWord16 :: Int -> ArrayT Word16 '[n,n]+foreign import javascript unsafe "h$easytensor_eyeUint32($1)" js_eyeWord32 :: Int -> ArrayT Word32 '[n,n]+foreign import javascript unsafe "h$easytensor_eyeUint8Clamped($1)" js_eyeWord8Clamped :: Int -> ArrayT Word8Clamped '[n,n]+++++instance (Fractional t, KnownNat n, ArrayT t '[n,n] ~ Array t '[n,n], 2 <= n) => MatrixInverse t n where+ inverse (KnownDataFrame m) = KnownDataFrame $ js_inverse m (dimVal' @n)++foreign import javascript unsafe "h$easytensor_inverse($1, $2)" js_inverse :: ArrayT t '[n,n] -> Int -> ArrayT t '[n,n]+++++++++++++++unsafeFreezeArrayT# :: MutableArrayT s t ds -> State# s -> (# State# s, ArrayT t ds #)+unsafeFreezeArrayT# a s = (# s, coerce a #)+{-# INLINE unsafeFreezeArrayT# #-}++--unsafeThawArrayT# :: ArrayT t ds -> State# s -> (#State# s, MutableArrayT s t ds #)+--unsafeThawArrayT# a s = (# s, coerce a #)+--{-# INLINE unsafeThawArrayT# #-}+++foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetFloat# :: Int# -> ArrayT Float ds -> Float#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetDouble# :: Int# -> ArrayT Double ds -> Double#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt# :: Int# -> ArrayT Int ds -> Int#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt8# :: Int# -> ArrayT Int8 ds -> Int#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt16# :: Int# -> ArrayT Int16 ds -> Int#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt32# :: Int# -> ArrayT Int32 ds -> Int#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord# :: Int# -> ArrayT Word ds -> Word#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord8# :: Int# -> ArrayT Word8 ds -> Word#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord8Clamped# :: Int# -> ArrayT Word8Clamped ds -> Int#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord16# :: Int# -> ArrayT Word16 ds -> Word#+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord32# :: Int# -> ArrayT Word32 ds -> Word#+++foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetFloat :: Int# -> ArrayT Float ds -> Float+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetDouble :: Int# -> ArrayT Double ds -> Double+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt :: Int# -> ArrayT Int ds -> Int+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt8 :: Int# -> ArrayT Int8 ds -> Int8+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt16 :: Int# -> ArrayT Int16 ds -> Int16+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetInt32 :: Int# -> ArrayT Int32 ds -> Int32+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord :: Int# -> ArrayT Word ds -> Word+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord8 :: Int# -> ArrayT Word8 ds -> Word8+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord8Clamped :: Int# -> ArrayT Word8Clamped ds -> Word8Clamped+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord16 :: Int# -> ArrayT Word16 ds -> Word16+foreign import javascript unsafe "$2[$1]" js_indexArrayOffsetWord32 :: Int# -> ArrayT Word32 ds -> Word32+++foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetFloat# :: Int# -> Float# -> ArrayT Float ds -> ArrayT Float ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetDouble# :: Int# -> Double# -> ArrayT Double ds -> ArrayT Double ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetInt# :: Int# -> Int# -> ArrayT Int ds -> ArrayT Int ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetInt8# :: Int# -> Int# -> ArrayT Int8 ds -> ArrayT Int8 ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetInt16# :: Int# -> Int# -> ArrayT Int16 ds -> ArrayT Int16 ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetInt32# :: Int# -> Int# -> ArrayT Int32 ds -> ArrayT Int32 ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetWord# :: Int# -> Word# -> ArrayT Word ds -> ArrayT Word ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetWord8# :: Int# -> Word# -> ArrayT Word8 ds -> ArrayT Word8 ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetWord8Clamped# :: Int# -> Int# -> ArrayT Word8Clamped ds -> ArrayT Word8Clamped ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetWord16# :: Int# -> Word# -> ArrayT Word16 ds -> ArrayT Word16 ds+foreign import javascript unsafe "$r = $3.slice(); $r[$1] = $2;" js_setArrayOffsetWord32# :: Int# -> Word# -> ArrayT Word32 ds -> ArrayT Word32 ds+++++--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetFloat# :: Int# -> MutableArrayT s Float ds -> State# s -> (# State# s, Float# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetDouble# :: Int# -> MutableArrayT s Double ds -> State# s -> (# State# s, Double# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetInt# :: Int# -> MutableArrayT s Int ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetInt8# :: Int# -> MutableArrayT s Int8 ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetInt16# :: Int# -> MutableArrayT s Int16 ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetInt32# :: Int# -> MutableArrayT s Int32 ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetWord# :: Int# -> MutableArrayT s Word ds -> State# s -> (# State# s, Word# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetWord8# :: Int# -> MutableArrayT s Word8 ds -> State# s -> (# State# s, Word# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetWord8Clamped# :: Int# -> MutableArrayT s Word8Clamped ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetWord16# :: Int# -> MutableArrayT s Word16 ds -> State# s -> (# State# s, Word# #)+--foreign import javascript unsafe "$2[$1]" js_readArrayOffsetWord32# :: Int# -> MutableArrayT s Word32 ds -> State# s -> (# State# s, Word# #)+++foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetFloat# :: Int# -> Float# -> MutableArrayT s Float ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetDouble# :: Int# -> Double# -> MutableArrayT s Double ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetInt# :: Int# -> Int# -> MutableArrayT s Int ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetInt8# :: Int# -> Int# -> MutableArrayT s Int8 ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetInt16# :: Int# -> Int# -> MutableArrayT s Int16 ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetInt32# :: Int# -> Int# -> MutableArrayT s Int32 ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetWord# :: Int# -> Word# -> MutableArrayT s Word ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetWord8# :: Int# -> Word# -> MutableArrayT s Word8 ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetWord8Clamped# :: Int# -> Int# -> MutableArrayT s Word8Clamped ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetWord16# :: Int# -> Word# -> MutableArrayT s Word16 ds -> State# s -> State# s+foreign import javascript unsafe "$3[$1] = $2;" js_writeArrayOffsetWord32# :: Int# -> Word# -> MutableArrayT s Word32 ds -> State# s -> State# s+++++++++-----------------------------------------------------------------------------+-- Conversions between types+-----------------------------------------------------------------------------+++++foreign import javascript unsafe "$1.length" js_length :: ArrayT t ds -> Int#+foreign import javascript unsafe "$1.byteOffset" js_byteOffset :: ArrayT t ds -> Int#+--foreign import javascript unsafe "$1.byteLength" js_byteLength :: ArrayT t ds -> Int#+++--foreign import javascript unsafe "$1.length" js_lengthM :: MutableArrayT s t ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$1.byteOffset" js_byteOffsetM :: MutableArrayT s t ds -> State# s -> (# State# s, Int# #)+--foreign import javascript unsafe "$1.byteLength" js_byteLengthM :: MutableArrayT s t ds -> State# s -> (# State# s, Int# #)++foreign import javascript unsafe "h$wrapBuffer($1.buffer)" js_wrapArrayT :: ArrayT t ds -> ByteArray#+--foreign import javascript unsafe "h$wrapBuffer($1.buffer)" js_wrapMutableArrayT :: MutableArrayT s t ds -> State# s -> (# State# s, MutableByteArray# s #)+--+--+--foreign import javascript unsafe "$1.f3 || new Float32Array($1.buf)" js_unwrapFloatArray :: ByteArray# -> ArrayT Float ds+--foreign import javascript unsafe "$1.f6 || new Float64Array($1.buf)" js_unwrapDoubleArray :: ByteArray# -> ArrayT Double ds+--foreign import javascript unsafe "$1.i3 || new Int32Array($1.buf)" js_unwrapIntArray :: ByteArray# -> ArrayT Int ds+--foreign import javascript unsafe "$1.i3 || new Int32Array($1.buf)" js_unwrapInt32Array :: ByteArray# -> ArrayT Int32 ds+--foreign import javascript unsafe "$1.i1 || new Int16Array($1.buf)" js_unwrapInt16Array :: ByteArray# -> ArrayT Int16 ds+--foreign import javascript unsafe "$1.i8 || new Int8Array($1.buf)" js_unwrapInt8Array :: ByteArray# -> ArrayT Int8 ds+--foreign import javascript unsafe "$1.u3 || new Uint32Array($1.buf)" js_unwrapWordArray :: ByteArray# -> ArrayT Word ds+--foreign import javascript unsafe "$1.u3 || new Uint32Array($1.buf)" js_unwrapWord32Array :: ByteArray# -> ArrayT Word32 ds+--foreign import javascript unsafe "$1.u1 || new Uint16Array($1.buf)" js_unwrapWord16Array :: ByteArray# -> ArrayT Word16 ds+--foreign import javascript unsafe "$1.u8 || new Uint8Array($1.buf)" js_unwrapWord8Array :: ByteArray# -> ArrayT Word8 ds+--foreign import javascript unsafe "$1.uc || new Uint8ClampedArray($1.buf)" js_unwrapWord8ClampedArray :: ByteArray# -> ArrayT Word8Clamped ds++++foreign import javascript unsafe "new Float32Array($1.buf, $2*4, $3)" js_unwrapFloatArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Float ds+foreign import javascript unsafe "new Float64Array($1.buf, $2*8, $3)" js_unwrapDoubleArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Double ds+foreign import javascript unsafe "new Int32Array($1.buf, $2*4, $3)" js_unwrapIntArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Int ds+foreign import javascript unsafe "new Int32Array($1.buf, $2*4, $3)" js_unwrapInt32ArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Int32 ds+foreign import javascript unsafe "new Int16Array($1.buf, $2*2, $3)" js_unwrapInt16ArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Int16 ds+foreign import javascript unsafe "new Int8Array($1.buf, $2, $3)" js_unwrapInt8ArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Int8 ds+foreign import javascript unsafe "new Uint32Array($1.buf, $2*4, $3)" js_unwrapWordArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Word ds+foreign import javascript unsafe "new Uint32Array($1.buf, $2*4, $3)" js_unwrapWord32ArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Word32 ds+foreign import javascript unsafe "new Uint16Array($1.buf, $2*2, $3)" js_unwrapWord16ArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Word16 ds+foreign import javascript unsafe "new Uint8Array($1.buf, $2, $3)" js_unwrapWord8ArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Word8 ds+foreign import javascript unsafe "new Uint8ClampedArray($1.buf, $2, $3)" js_unwrapWord8ClampedArrayOffLen :: ByteArray# -> Int# -> Int# -> ArrayT Word8Clamped ds+++--foreign import javascript unsafe "$1.i3 || new Int32Array($1.buf)" js_unwrapMutableIntArray :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Int ds #)+--foreign import javascript unsafe "$1.i3 || new Int32Array($1.buf)" js_unwrapMutableInt32Array :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Int32 ds #)+--foreign import javascript unsafe "$1.i1 || new Int16Array($1.buf)" js_unwrapMutableInt16Array :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Int16 ds #)+--foreign import javascript unsafe "$1.i8 || new Int8Array($1.buf)" js_unwrapMutableInt8Array :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Int8 ds #)+--foreign import javascript unsafe "$1.u3 || new Uint32Array($1.buf)" js_unwrapMutableWordArray :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Word ds #)+--foreign import javascript unsafe "$1.u3 || new Uint32Array($1.buf)" js_unwrapMutableWord32Array :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Word32 ds #)+--foreign import javascript unsafe "$1.u1 || new Uint16Array($1.buf)" js_unwrapMutableWord16Array :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Word16 ds #)+--foreign import javascript unsafe "$1.u8 || new Uint8Array($1.buf)" js_unwrapMutableWord8Array :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Word8 ds #)+--foreign import javascript unsafe "$1.f3 || new Float32Array($1.buf)" js_unwrapMutableFloatArray :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Float ds #)+--foreign import javascript unsafe "$1.f6 || new Float64Array($1.buf)" js_unwrapMutableDoubleArray :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Double ds #)+--foreign import javascript unsafe "$1.uc || new Uint8ClampedArray($1.buf)" js_unwrapMutableWord8ClampedArray :: MutableByteArray# s -> State# s -> (# State# s, MutableArrayT s Word8Clamped ds #)++++-----------------------------------------------------------------------------+-- Create new arrays+-----------------------------------------------------------------------------++foreign import javascript unsafe "new Float32Array($1)" js_createFloatArray :: Int# -> State# s -> (# State# s, MutableArrayT s Float ds #)+foreign import javascript unsafe "new Float64Array($1)" js_createDoubleArray :: Int# -> State# s -> (# State# s, MutableArrayT s Double ds #)+foreign import javascript unsafe "new Int32Array($1)" js_createIntArray :: Int# -> State# s -> (# State# s, MutableArrayT s Int ds #)+foreign import javascript unsafe "new Int32Array($1)" js_createInt32Array :: Int# -> State# s -> (# State# s, MutableArrayT s Int32 ds #)+foreign import javascript unsafe "new Int16Array($1)" js_createInt16Array :: Int# -> State# s -> (# State# s, MutableArrayT s Int16 ds #)+foreign import javascript unsafe "new Int8Array($1)" js_createInt8Array :: Int# -> State# s -> (# State# s, MutableArrayT s Int8 ds #)+foreign import javascript unsafe "new Uint32Array($1)" js_createWordArray :: Int# -> State# s -> (# State# s, MutableArrayT s Word ds #)+foreign import javascript unsafe "new Uint32Array($1)" js_createWord32Array :: Int# -> State# s -> (# State# s, MutableArrayT s Word32 ds #)+foreign import javascript unsafe "new Uint16Array($1)" js_createWord16Array :: Int# -> State# s -> (# State# s, MutableArrayT s Word16 ds #)+foreign import javascript unsafe "new Uint8Array($1)" js_createWord8Array :: Int# -> State# s -> (# State# s, MutableArrayT s Word8 ds #)+foreign import javascript unsafe "new Uint8ClampedArray($1)" js_createWord8ClampedArray :: Int# -> State# s -> (# State# s, MutableArrayT s Word8Clamped ds #)++foreign import javascript unsafe "new Float32Array($1).fill($2)" js_fillNewFloatArray :: Int -> Float -> ArrayT Float ds+foreign import javascript unsafe "new Float64Array($1).fill($2)" js_fillNewDoubleArray :: Int -> Double -> ArrayT Double ds+foreign import javascript unsafe "new Int32Array($1).fill($2)" js_fillNewIntArray :: Int -> Int -> ArrayT Int ds+foreign import javascript unsafe "new Int32Array($1).fill($2)" js_fillNewInt32Array :: Int -> Int32 -> ArrayT Int32 ds+foreign import javascript unsafe "new Int16Array($1).fill($2)" js_fillNewInt16Array :: Int -> Int16 -> ArrayT Int16 ds+foreign import javascript unsafe "new Int8Array($1).fill($2)" js_fillNewInt8Array :: Int -> Int8 -> ArrayT Int8 ds+foreign import javascript unsafe "new Uint32Array($1).fill($2)" js_fillNewWordArray :: Int -> Word -> ArrayT Word ds+foreign import javascript unsafe "new Uint32Array($1).fill($2)" js_fillNewWord32Array :: Int -> Word32 -> ArrayT Word32 ds+foreign import javascript unsafe "new Uint16Array($1).fill($2)" js_fillNewWord16Array :: Int -> Word16 -> ArrayT Word16 ds+foreign import javascript unsafe "new Uint8Array($1).fill($2)" js_fillNewWord8Array :: Int -> Word8 -> ArrayT Word8 ds+foreign import javascript unsafe "new Uint8ClampedArray($1).fill($2)" js_fillNewWord8ClampedArray :: Int -> Word8Clamped -> ArrayT Word8Clamped ds++++++-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Float32Array(arr.length); $r.set(arr);" js_fromListFloatArray :: Exts.Any -> ArrayT Float ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Float64Array(arr.length); $r.set(arr);" js_fromListDoubleArray :: Exts.Any -> ArrayT Double ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Int32Array(arr.length); $r.set(arr);" js_fromListIntArray :: Exts.Any -> ArrayT Int ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Int32Array(arr.length); $r.set(arr);" js_fromListInt32Array :: Exts.Any -> ArrayT Int32 ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Int16Array(arr.length); $r.set(arr);" js_fromListInt16Array :: Exts.Any -> ArrayT Int16 ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Int8Array(arr.length); $r.set(arr);" js_fromListInt8Array :: Exts.Any -> ArrayT Int8 ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Uint32Array(arr.length); $r.set(arr);" js_fromListWordArray :: Exts.Any -> ArrayT Word ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Uint32Array(arr.length); $r.set(arr);" js_fromListWord32Array :: Exts.Any -> ArrayT Word32 ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Uint16Array(arr.length); $r.set(arr);" js_fromListWord16Array :: Exts.Any -> ArrayT Word16 ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Uint8Array(arr.length); $r.set(arr);" js_fromListWord8Array :: Exts.Any -> ArrayT Word8 ds+-- foreign import javascript unsafe "var arr = LikeHS.listToArrayNoUnwrap($1); $r = new Uint8ClampedArray(arr.length); $r.set(arr);" js_fromListWord8ClampedArray :: Exts.Any -> ArrayT Word8Clamped ds+++-- foreign import javascript unsafe "$r = new Float32Array($1.length); $r.set($1);" js_fromArrayFloatArray :: SomeTypedArray m0 t -> ArrayT Float ds+-- foreign import javascript unsafe "new Float32Array($1)" js_viewFloatArray :: SomeArrayBuffer m -> ArrayT Float ds+--+-- foreign import javascript unsafe "$r = new Float64Array($1.length); $r.set($1);" js_fromArrayDoubleArray :: SomeTypedArray m0 t -> ArrayT Double ds+-- foreign import javascript unsafe "new Float64Array($1)" js_viewDoubleArray :: SomeArrayBuffer m -> ArrayT Double ds+--+-- foreign import javascript unsafe "$r = new Int32Array($1.length); $r.set($1);" js_fromArrayIntArray :: SomeTypedArray m0 t -> ArrayT Int ds+-- foreign import javascript unsafe "new Int32Array($1)" js_viewIntArray :: SomeArrayBuffer m -> ArrayT Int ds+--+-- foreign import javascript unsafe "$r = new Int32Array($1.length); $r.set($1);" js_fromArrayInt32Array :: SomeTypedArray m0 t -> ArrayT Int32 ds+-- foreign import javascript unsafe "new Int32Array($1)" js_viewInt32Array :: SomeArrayBuffer m -> ArrayT Int32 ds+--+-- foreign import javascript unsafe "$r = new Int16Array($1.length); $r.set($1);" js_fromArrayInt16Array :: SomeTypedArray m0 t -> ArrayT Int16 ds+-- foreign import javascript unsafe "new Int16Array($1)" js_viewInt16Array :: SomeArrayBuffer m -> ArrayT Int16 ds+--+-- foreign import javascript unsafe "$r = new Int8Array($1.length); $r.set($1);" js_fromArrayInt8Array :: SomeTypedArray m0 t -> ArrayT Int8 ds+-- foreign import javascript unsafe "new Int8Array($1)" js_viewInt8Array :: SomeArrayBuffer m -> ArrayT Int8 ds+--+-- foreign import javascript unsafe "$r = new Uint32Array($1.length); $r.set($1);" js_fromArrayWordArray :: SomeTypedArray m0 t -> ArrayT Word ds+-- foreign import javascript unsafe "new Uint32Array($1)" js_viewWordArray :: SomeArrayBuffer m -> ArrayT Word ds+--+-- foreign import javascript unsafe "$r = new Uint32Array($1.length); $r.set($1);" js_fromArrayWord32Array :: SomeTypedArray m0 t -> ArrayT Word32 ds+-- foreign import javascript unsafe "new Uint32Array($1)" js_viewWord32Array :: SomeArrayBuffer m -> ArrayT Word32 ds+--+-- foreign import javascript unsafe "$r = new Uint16Array($1.length); $r.set($1);" js_fromArrayWord16Array :: SomeTypedArray m0 t -> ArrayT Word16 ds+-- foreign import javascript unsafe "new Uint16Array($1)" js_viewWord16Array :: SomeArrayBuffer m -> ArrayT Word16 ds+--+-- foreign import javascript unsafe "$r = new Uint8Array($1.length); $r.set($1);" js_fromArrayWord8Array :: SomeTypedArray m0 t -> ArrayT Word8 ds+-- foreign import javascript unsafe "new Uint8Array($1)" js_viewWord8Array :: SomeArrayBuffer m -> ArrayT Word8 ds+--+-- foreign import javascript unsafe "$r = new Uint8ClampedArray($1.length); $r.set($1);" js_fromArrayWord8ClampedArray :: SomeTypedArray m0 t -> ArrayT Word8Clamped ds+-- foreign import javascript unsafe "new Uint8ClampedArray($1)" js_viewWord8ClampedArray :: SomeArrayBuffer m -> ArrayT Word8Clamped ds
+ src-ghcjs/Numeric/Array/Family/ArrayT.js view
@@ -0,0 +1,444 @@++// hypot may be not supported on old browsers and IE+// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/hypot+Math.hypot = Math.hypot || function() {+ var y = 0;+ var length = arguments.length;++ for (var i = 0; i < length; i++) {+ if (arguments[i] === Infinity || arguments[i] === -Infinity) {+ return Infinity;+ }+ y += arguments[i] * arguments[i];+ }+ return Math.sqrt(y);+};+++// ---------------------------------------------------------------------------------------- //+// --- Polyfills for partially missing math functions ------------------------------------- //+// ---------------------------------------------------------------------------------------- //++Math.hypot = Math.hypot || function() {+ var y = 0;+ var length = arguments.length;++ for (var i = 0; i < length; i++) {+ if (arguments[i] === Infinity || arguments[i] === -Infinity) {+ return Infinity;+ }+ y += arguments[i] * arguments[i];+ }+ return Math.sqrt(y);+};+Math.tanh = Math.tanh || function(x){+ var a = Math.exp(+x), b = Math.exp(-x);+ return a == Infinity ? 1 : b == Infinity ? -1 : (a - b) / (a + b);+};+Math.atanh = Math.atanh || function(x) {+ return Math.log((1+x)/(1-x)) / 2;+};+Math.acosh = Math.acosh || function(x) {+ return Math.log(x + Math.sqrt(x * x - 1));+};+Math.asinh = Math.asinh || function(x) {+ if (x === -Infinity) {+ return x;+ } else {+ return Math.log(x + Math.sqrt(x * x + 1));+ }+};+Math.cosh = Math.cosh || function(x) {+ var y = Math.exp(x);+ return (y + 1 / y) / 2;+};+Math.sinh = Math.sinh || function(x) {+ var y = Math.exp(x);+ return (y - 1 / y) / 2;+};++// ---------------------------------------------------------------------------------------- //+// --- Polyfills for partially missing typed array functions ------------------------------ //+// ---------------------------------------------------------------------------------------- //++(function () {++function polyfill_map(q) {+ if (!q.prototype.map) {+ q.prototype.map = function(f) {+ var y = new this.constructor(this.length);+ for(var i = 0; i < this.length; i++) {+ y[i] = f(this[i],i,this);+ }+ return y;+ };+ }+}+function polyfill_fill(q) {+ if (!q.prototype.fill) {+ q.prototype.fill = function(val, start, end) {+ start = start === undefined ? 0 : (start < 0 ? this.length - start : start);+ end = end === undefined ? this.length : (end < 0 ? this.length - end : end);+ for(var i = start; i < end; i++) {+ this[i] = val;+ }+ return this;+ };+ }+}+function polyfill_reduce(q) {+ if (!q.prototype.reduce) {+ q.prototype.reduce = function(f, y0) {+ var i0 = y0 === undefined ? 1 : 0,+ y = i0 === 1 ? this[0] : y0;+ for(var i = i0; i < this.length; i++) {+ y = f(y,this[i],i,this);+ }+ return y;+ };+ }+}+function polyfill_slice(q) {+ if (!q.prototype.slice) {+ q.prototype.slice = function(start, end) {+ start = start === undefined ? 0 : (start < 0 ? this.length - start : start);+ end = end === undefined ? this.length : (end < 0 ? this.length - end : end);+ var xview = this.subarray(start, end),+ y = new xview.constructor(xview.length);+ y.set(xview);+ return y;+ };+ }+}+function polyfill_every(q) {+ if (!q.prototype.every) {+ q.prototype.every = function(f) {+ if (this.length === 0) return true;+ for(var i = 0; i < this.length; i++) {+ if (!f(this[i],i,this)) { return false; }+ }+ return true;+ };+ }+}+function polyfill_some(q) {+ if (!q.prototype.some) {+ q.prototype.some = function(f) {+ if (this.length === 0) return false;+ for(var i = 0; i < this.length; i++) {+ if (f(this[i],i,this)) { return true; }+ }+ return false;+ };+ }+}+++var methods = [polyfill_map, polyfill_fill, polyfill_reduce, polyfill_slice, polyfill_every, polyfill_some];++if (typeof Int8Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Int8Array); }+}+if (typeof Uint8Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Uint8Array); }+}+if (typeof Uint8ClampedArray !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Uint8ClampedArray); }+}+if (typeof Int16Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Int16Array); }+}+if (typeof Uint16Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Uint16Array); }+}+if (typeof Int32Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Int32Array); }+}+if (typeof Uint32Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Uint32Array); }+}+if (typeof Float32Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Float32Array); }+}+if (typeof Float64Array !== 'undefined') {+ for (var i = methods.length; i--;) { methods[i](Float64Array); }+}++}());++// ---------------------------------------------------------------------------------------- //+++function h$easytensor_transpose(n, mat) {+ var nmat = new mat.constructor(mat.length),+ m = Math.round(mat.length / n);+ for(var i = 0; i < n; i++) {+ for(var j = 0; j < m; j++) {+ nmat[i*m+j] = mat[j*n+i];+ }+ }+ return nmat;+}++function h$easytensor_eyeFloat32(n) {+ var mat = new Float32Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeFloat64(n) {+ var mat = new Float64Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeInt8(n) {+ var mat = new Int8Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeInt16(n) {+ var mat = new Int16Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeInt32(n) {+ var mat = new Int32Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeUint8(n) {+ var mat = new Uint8Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeUint8Clamped(n) {+ var mat = new Uint8ClampedArray(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeUint16(n) {+ var mat = new Uint16Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+function h$easytensor_eyeUint32(n) {+ var mat = new Uint32Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=1;}+ return mat;+}+++function h$easytensor_diagFloat32(n,x) {+ var mat = new Float32Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagFloat64(n,x) {+ var mat = new Float64Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagInt8(n,x) {+ var mat = new Int8Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagInt16(n,x) {+ var mat = new Int16Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagInt32(n,x) {+ var mat = new Int32Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagUint8(n,x) {+ var mat = new Uint8Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagUint8Clamped(n,x) {+ var mat = new Uint8ClampedArray(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagUint16(n,x) {+ var mat = new Uint16Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}+function h$easytensor_diagUint32(n,x) {+ var mat = new Uint32Array(n*n).fill(0);+ for(var i = 0; i < n*n; i += n + 1){mat[i]=x;}+ return mat;+}++function h$easytensor_trace(mat, n) {+ var r = 0;+ for(var i = 0; i < n*n; i += n + 1){r+=mat[i];}+ return r;+}+++function h$easytensor_det(mat, n) {+ switch (n) {+ case 1:+ return mat[0];+ case 2:+ return h$easytensor_detJSMat2(mat);+ case 3:+ return h$easytensor_detJSMat3(mat);+ case 4:+ return h$easytensor_detJSMat4(mat);+ default:+ throw "Determinant for n = " + n + " is not implemented or does not make sense.";+ }+}++function h$easytensor_detJSMat2(mat) {+ return (mat[0]*mat[3] - mat[1]*mat[2]);+}++function h$easytensor_detJSMat3(mat) {+ return (+ mat[0]*(mat[4]*mat[8]-mat[5]*mat[7])+ - mat[1]*(mat[3]*mat[8]-mat[5]*mat[6])+ + mat[2]*(mat[3]*mat[7]-mat[4]*mat[6])+ );+}++function h$easytensor_detJSMat4(mat) {+ var n11 = mat[ 0 ], n12 = mat[ 4 ], n13 = mat[ 8 ], n14 = mat[ 12 ];+ var n21 = mat[ 1 ], n22 = mat[ 5 ], n23 = mat[ 9 ], n24 = mat[ 13 ];+ var n31 = mat[ 2 ], n32 = mat[ 6 ], n33 = mat[ 10 ], n34 = mat[ 14 ];+ var n41 = mat[ 3 ], n42 = mat[ 7 ], n43 = mat[ 11 ], n44 = mat[ 15 ];++ return (+ n41 * (+ + n14 * n23 * n32+ - n13 * n24 * n32+ - n14 * n22 * n33+ + n12 * n24 * n33+ + n13 * n22 * n34+ - n12 * n23 * n34+ ) ++ n42 * (+ + n11 * n23 * n34+ - n11 * n24 * n33+ + n14 * n21 * n33+ - n13 * n21 * n34+ + n13 * n24 * n31+ - n14 * n23 * n31+ ) ++ n43 * (+ + n11 * n24 * n32+ - n11 * n22 * n34+ - n14 * n21 * n32+ + n12 * n21 * n34+ + n14 * n22 * n31+ - n12 * n24 * n31+ ) ++ n44 * (+ - n13 * n22 * n31+ - n11 * n23 * n32+ + n11 * n22 * n33+ + n13 * n21 * n32+ - n12 * n21 * n33+ + n12 * n23 * n31+ )+ );+}+++++function h$easytensor_inverse(mat, n) {+ switch (n) {+ case 1:+ return 1 / mat[0];+ case 2:+ return h$easytensor_inverseJSM2(mat);+ case 3:+ return h$easytensor_inverseJSM3(mat);+ case 4:+ return h$easytensor_inverseJSM4(mat);+ default:+ throw "Inverse for n = " + n + " is not implemented or does not make sense.";+ }+}+++function h$easytensor_inverseJSM4(mat) {+ var rez = new mat.constructor(16);+ rez[0] = mat[13]*(mat[ 6]*mat[11]-mat[10]*mat[ 7])+mat[ 9]*(mat[14]*mat[ 7]-mat[ 6]*mat[15])+mat[ 5]*(mat[10]*mat[15]-mat[14]*mat[11]); + rez[4] = mat[12]*(mat[10]*mat[ 7]-mat[ 6]*mat[11])+mat[ 8]*(mat[ 6]*mat[15]-mat[14]*mat[ 7])+mat[ 4]*(mat[14]*mat[11]-mat[10]*mat[15]); + rez[8] = mat[12]*(mat[ 5]*mat[11]-mat[ 9]*mat[ 7])+mat[ 8]*(mat[13]*mat[ 7]-mat[ 5]*mat[15])+mat[ 4]*(mat[ 9]*mat[15]-mat[13]*mat[11]); + rez[12] = mat[12]*(mat[ 9]*mat[ 6]-mat[ 5]*mat[10])+mat[ 8]*(mat[ 5]*mat[14]-mat[13]*mat[ 6])+mat[ 4]*(mat[13]*mat[10]-mat[ 9]*mat[14]); + rez[1] = mat[13]*(mat[10]*mat[ 3]-mat[ 2]*mat[11])+mat[ 9]*(mat[ 2]*mat[15]-mat[14]*mat[ 3])+mat[ 1]*(mat[14]*mat[11]-mat[10]*mat[15]); + rez[5] = mat[12]*(mat[ 2]*mat[11]-mat[10]*mat[ 3])+mat[ 8]*(mat[14]*mat[ 3]-mat[ 2]*mat[15])+mat[ 0]*(mat[10]*mat[15]-mat[14]*mat[11]); + rez[9] = mat[12]*(mat[ 9]*mat[ 3]-mat[ 1]*mat[11])+mat[ 8]*(mat[ 1]*mat[15]-mat[13]*mat[ 3])+mat[ 0]*(mat[13]*mat[11]-mat[ 9]*mat[15]); + rez[13] = mat[12]*(mat[ 1]*mat[10]-mat[ 9]*mat[ 2])+mat[ 8]*(mat[13]*mat[ 2]-mat[ 1]*mat[14])+mat[ 0]*(mat[ 9]*mat[14]-mat[13]*mat[10]); + rez[2] = mat[13]*(mat[ 2]*mat[ 7]-mat[ 6]*mat[ 3])+mat[ 5]*(mat[14]*mat[ 3]-mat[ 2]*mat[15])+mat[ 1]*(mat[ 6]*mat[15]-mat[14]*mat[ 7]); + rez[6] = mat[12]*(mat[ 6]*mat[ 3]-mat[ 2]*mat[ 7])+mat[ 4]*(mat[ 2]*mat[15]-mat[14]*mat[ 3])+mat[ 0]*(mat[14]*mat[ 7]-mat[ 6]*mat[15]); + rez[10] = mat[12]*(mat[ 1]*mat[ 7]-mat[ 5]*mat[ 3])+mat[ 4]*(mat[13]*mat[ 3]-mat[ 1]*mat[15])+mat[ 0]*(mat[ 5]*mat[15]-mat[13]*mat[ 7]); + rez[14] = mat[12]*(mat[ 5]*mat[ 2]-mat[ 1]*mat[ 6])+mat[ 4]*(mat[ 1]*mat[14]-mat[13]*mat[ 2])+mat[ 0]*(mat[13]*mat[ 6]-mat[ 5]*mat[14]); + rez[3] = mat[ 9]*(mat[ 6]*mat[ 3]-mat[ 2]*mat[ 7])+mat[ 5]*(mat[ 2]*mat[11]-mat[10]*mat[ 3])+mat[ 1]*(mat[10]*mat[ 7]-mat[ 6]*mat[11]); + rez[7] = mat[ 8]*(mat[ 2]*mat[ 7]-mat[ 6]*mat[ 3])+mat[ 4]*(mat[10]*mat[ 3]-mat[ 2]*mat[11])+mat[ 0]*(mat[ 6]*mat[11]-mat[10]*mat[ 7]); + rez[11] = mat[ 8]*(mat[ 5]*mat[ 3]-mat[ 1]*mat[ 7])+mat[ 4]*(mat[ 1]*mat[11]-mat[ 9]*mat[ 3])+mat[ 0]*(mat[ 9]*mat[ 7]-mat[ 5]*mat[11]); + rez[15] = mat[ 8]*(mat[ 1]*mat[ 6]-mat[ 5]*mat[ 2])+mat[ 4]*(mat[ 9]*mat[ 2]-mat[ 1]*mat[10])+mat[ 0]*(mat[ 5]*mat[10]-mat[ 9]*mat[ 6]);+ var det = mat[ 0]*rez[ 0] + mat[ 1]*rez[ 4] + mat[ 2]*rez[ 8] + mat[3]*rez[12];+ if (det === 0) {+ return undefined;+ } else {+ for(var i = 0; i < 16; i++) {rez[i] !== det;}+ return rez;+ }+}++function h$easytensor_inverseJSM3(mat) {+ var rez = new mat.constructor(9);+ rez[0] = mat[4]*mat[8] - mat[7]*mat[5]; + rez[3] = mat[6]*mat[5] - mat[3]*mat[8]; + rez[6] = mat[3]*mat[7] - mat[6]*mat[4]; + rez[1] = mat[7]*mat[2] - mat[1]*mat[8]; + rez[4] = mat[0]*mat[8] - mat[6]*mat[2]; + rez[7] = mat[6]*mat[1] - mat[0]*mat[7]; + rez[2] = mat[1]*mat[5] - mat[4]*mat[2]; + rez[5] = mat[3]*mat[2] - mat[0]*mat[5]; + rez[8] = mat[0]*mat[4] - mat[3]*mat[1];+ var det = mat[0]*rez[0] + mat[1]*rez[3] + mat[2]*rez[6];+ if (det === 0) {+ return undefined;+ } else {+ for(var i = 0; i < 9; i++) {rez[i] !== det;}+ return rez;+ }+}++function h$easytensor_inverseJSM2(mat) {+ var det = mat[0]*mat[3] - mat[1]*mat[2];+ if (det === 0) {+ return undefined;+ }+ var rez = new mat.constructor(4);+ rez[0] = mat[3]/det;+ rez[2] = -mat[1]/det;+ rez[1] = -mat[2]/det;+ rez[3] = mat[0]/det;+ return rez;+}+++function h$easytensor_contract(n,m,k,lhs,rhs) {+ var t, rez = new lhs.constructor(n*k);+ for(var i = 0; i < n; i++) {+ for(var j = 0; j < k; j++) {+ t = 0;+ for(var l = 0; l < m; l++) {+ t += lhs[i+l*n]*rhs[l+j*m];+ }+ rez[i+j*n] = t;+ }+ }+ return rez;+}
+ src-ghcjs/Numeric/DataFrame/Contraction.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE InstanceSigs #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.DataFrame.Contraction+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+-- This modules provides generalization of a matrix product:+-- tensor-like contraction.+-- For matrices and vectors this is a normal matrix*matrix or vector*matrix or matrix*vector product,+-- for larger dimensions it calculates the scalar product of "adjacent" dimesnions of a tensor.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Contraction+ ( Contraction (..), (%*)+ ) where++import Data.Type.Equality ((:~:) (..))+import GHC.Prim+import GHC.Types (Int (..), Type)+import Unsafe.Coerce (unsafeCoerce)++import Numeric.Array.Family+import Numeric.DataFrame.Type+import Numeric.Dimensions++++class ConcatList as bs asbs+ => Contraction (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])+ | asbs as -> bs, asbs bs -> as, as bs -> asbs where+ -- | Generalization of a matrix product: take scalar product over one dimension+ -- and, thus, concatenate other dimesnions+ contract :: ( KnownDim m )+ => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs++-- | Tensor contraction.+-- In particular:+-- 1. matrix-matrix product+-- 2. matrix-vector or vector-matrix product+-- 3. dot product of two vectors.+(%*) :: ( ConcatList as bs (as ++ bs)+ , Contraction t as bs asbs+ , KnownDim m+ ) => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t (as ++ bs)+(%*) = contract+{-# INLINE (%*) #-}+infixl 7 %*++instance ( ConcatList as bs asbs+ , Dimensions as+ , Dimensions bs+ ) => Contraction t as bs asbs where+ contract :: forall m . KnownDim m => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs+ contract dx dy+ | Refl <- unsafeCoerce Refl :: Array t asbs :~: ArrayT t asbs+ , Refl <- unsafeCoerce Refl :: Array t (as +: m) :~: ArrayT t (as +: m)+ , Evidence <- inferConcatDimensions @as @bs+ = KnownDataFrame $ js_conctract @t @as @m @bs (dimVal (dim @as)) (dimVal' @m) (dimVal (dim @bs)) (coerce dx) (coerce dy)+++foreign import javascript unsafe "h$easytensor_contract($1,$2,$3,$4,$5)"+ js_conctract :: forall t as m bs . Int -> Int -> Int -> ArrayT t (as +: m) -> ArrayT t (m :+ bs) -> ArrayT t (as ++ bs)
+ src-ghcjs/Numeric/DataFrame/Inference.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-----------------------------------------------------------------------------+-- |+-- Module : Numeric.DataFrame.Inference+-- Copyright : (c) Artem Chirkin+-- License : BSD3+--+-- Maintainer : chirkin@arch.ethz.ch+--+-- The module provides data types and functions to infer typeclasses at runtime.+--+-----------------------------------------------------------------------------++module Numeric.DataFrame.Inference+ ( PrimBytesEvidence, inferPrimBytes+ , ElementWiseEvidence, inferElementWise+ , NumericFrameEvidence, inferNumericFrame+ ) where++import Numeric.Array+import Numeric.Array.ElementWise+import Numeric.Commons+import Numeric.DataFrame.Type+import Numeric.Dimensions+++-- | Evidence for PrimBytes class+type PrimBytesEvidence t (ds :: [Nat])+ = Evidence (PrimBytes (DataFrame t ds))++-- | Evidence for ElementWise class+type ElementWiseEvidence t (ds :: [Nat])+ = Evidence (ElementWise (Idx ds) t (DataFrame t ds))++-- | Allow all common operations on available data frames+type NumericFrameEvidence t (ds :: [Nat])+ = Evidence ( NumericFrame t ds)++inferPrimBytes :: forall t (ds :: [Nat])+ . ( ArrayInstanceInference t ds+ , Dimensions ds+ )+ => PrimBytesEvidence t ds+inferPrimBytes = case getArrayInstance @t @ds of+ AIScalar -> case elemTypeInstance @t of+ ETFloat -> Evidence+ ETDouble -> Evidence+ ETInt -> Evidence+ ETInt8 -> Evidence+ ETInt16 -> Evidence+ ETInt32 -> Evidence+ ETWord -> Evidence+ ETWord8 -> Evidence+ ETWord16 -> Evidence+ ETWord32 -> Evidence+ ETWord8C -> Evidence+ AIArrayF -> Evidence+ AIArrayD -> Evidence+ AIArrayI -> Evidence+ AIArrayI8 -> Evidence+ AIArrayI16 -> Evidence+ AIArrayI32 -> Evidence+ AIArrayW -> Evidence+ AIArrayW8 -> Evidence+ AIArrayW16 -> Evidence+ AIArrayW32 -> Evidence+ AIArrayW8C -> Evidence++inferElementWise :: forall t (ds :: [Nat])+ . ( ArrayInstanceInference t ds+ , Dimensions ds+ )+ => ElementWiseEvidence t ds+inferElementWise = case getArrayInstance @t @ds of+ AIScalar -> Evidence+ AIArrayF -> Evidence+ AIArrayD -> Evidence+ AIArrayI -> Evidence+ AIArrayI8 -> Evidence+ AIArrayI16 -> Evidence+ AIArrayI32 -> Evidence+ AIArrayW -> Evidence+ AIArrayW8 -> Evidence+ AIArrayW16 -> Evidence+ AIArrayW32 -> Evidence+ AIArrayW8C -> Evidence+++inferNumericFrame :: forall t (ds :: [Nat])+ . ( ArrayInstanceInference t ds+ , Dimensions ds+ )+ => NumericFrameEvidence t ds+inferNumericFrame+ | Evidence <- inferDimKnownDims @ds +!+ inferDimFiniteList @ds+ = case getArrayInstance @t @ds of+ AIScalar -> case elemTypeInstance @t of+ ETFloat -> Evidence+ ETDouble -> Evidence+ ETInt -> Evidence+ ETInt8 -> Evidence+ ETInt16 -> Evidence+ ETInt32 -> Evidence+ ETWord -> Evidence+ ETWord8 -> Evidence+ ETWord16 -> Evidence+ ETWord32 -> Evidence+ ETWord8C -> Evidence+ AIArrayF -> Evidence+ AIArrayD -> Evidence+ AIArrayI -> Evidence+ AIArrayI8 -> Evidence+ AIArrayI16 -> Evidence+ AIArrayI32 -> Evidence+ AIArrayW -> Evidence+ AIArrayW8 -> Evidence+ AIArrayW16 -> Evidence+ AIArrayW32 -> Evidence+ AIArrayW8C -> Evidence
− src/Numeric/Array.hs
@@ -1,33 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Numeric.Array--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch------ Low-level implementations of data frames-----------------------------------------------------------------------------------module Numeric.Array- ( module Numeric.Array.Family- ) where--import Numeric.Array.Family-import Numeric.Array.Family.ArrayD ()-import Numeric.Array.Family.ArrayF ()-import Numeric.Array.Family.ArrayI ()-import Numeric.Array.Family.ArrayI8 ()-import Numeric.Array.Family.ArrayI16 ()-import Numeric.Array.Family.ArrayI32 ()-import Numeric.Array.Family.ArrayI64 ()-import Numeric.Array.Family.ArrayW ()-import Numeric.Array.Family.ArrayW8 ()-import Numeric.Array.Family.ArrayW16 ()-import Numeric.Array.Family.ArrayW32 ()-import Numeric.Array.Family.ArrayW64 ()--import Numeric.Array.Family.FloatX2 ()-import Numeric.Array.Family.FloatX3 ()-import Numeric.Array.Family.FloatX4 ()
src/Numeric/Array/ElementWise.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE Strict #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE Strict #-} ----------------------------------------------------------------------------- -- | -- Module : Numeric.Array.ElementWise@@ -17,15 +19,23 @@ ( ElementWise (..) ) where +#ifdef ghcjs_HOST_OS+import Data.Int (Int16, Int32, Int8)+import Data.Word (Word16, Word32, Word8)+#else import Data.Int (Int16, Int32, Int64, Int8) import Data.Word (Word16, Word32, Word64, Word8)+#endif+import GHC.Prim (Int#) -- | Access elements. -- i is an index type -- x is an element -- t is a container type class ElementWise i x t | t -> x i where- -- | Index a container+ -- | Index an element by its offset in the container+ indexOffset# :: t -> Int# -> x+ -- | Index an element in the container (!) :: t -> i -> x -- | map all elements with index ewmap :: (i -> x -> x) -> t -> t@@ -49,6 +59,8 @@ instance ElementWise Int Float Float where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -73,6 +85,8 @@ instance ElementWise Int Double Double where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -95,6 +109,8 @@ instance ElementWise Int Int Int where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -117,6 +133,8 @@ instance ElementWise Int Int8 Int8 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -138,6 +156,8 @@ {-# INLINE update #-} instance ElementWise Int Int16 Int16 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -159,6 +179,8 @@ {-# INLINE update #-} instance ElementWise Int Int32 Int32 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -180,7 +202,10 @@ {-# INLINE update #-} +#ifndef ghcjs_HOST_OS instance ElementWise Int Int64 Int64 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -200,9 +225,11 @@ {-# INLINE broadcast #-} update _ = const {-# INLINE update #-}-+#endif instance ElementWise Int Word Word where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -225,6 +252,8 @@ instance ElementWise Int Word8 Word8 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -247,6 +276,8 @@ instance ElementWise Int Word16 Word16 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -269,6 +300,8 @@ instance ElementWise Int Word32 Word32 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -290,7 +323,10 @@ {-# INLINE update #-} +#ifndef ghcjs_HOST_OS instance ElementWise Int Word64 Word64 where+ indexOffset# x _ = x+ {-# INLINE indexOffset# #-} (!) x _ = x {-# INLINE (!) #-} ewmap f = f 1@@ -310,3 +346,4 @@ {-# INLINE broadcast #-} update _ = const {-# INLINE update #-}+#endif
− src/Numeric/Array/Family.hs
@@ -1,422 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeFamilyDependencies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE StandaloneDeriving #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family- ( Array- , ArrayF (..), ArrayD (..)- , ArrayI (..), ArrayI8 (..), ArrayI16 (..), ArrayI32 (..), ArrayI64 (..)- , ArrayW (..), ArrayW8 (..), ArrayW16 (..), ArrayW32 (..), ArrayW64 (..)- , Scalar (..)- , FloatX2 (..), FloatX3 (..), FloatX4 (..)- , ArrayInstanceInference, ElemType (..), ArraySize (..)- , ElemTypeInference (..), ArraySizeInference (..), ArrayInstanceEvidence- , getArrayInstance, ArrayInstance (..), inferArrayInstance- ) where---import Data.Int (Int16, Int32, Int64, Int8)-import Data.Type.Equality ((:~:) (..))-import Data.Word (Word16, Word32, Word64, Word8)-import GHC.Prim (ByteArray#, Double#, Float#, Int#,- Word#, unsafeCoerce#)--import Numeric.Array.ElementWise-import Numeric.Commons-import Numeric.TypeLits-import Numeric.Dimensions---- | Full collection of n-order arrays-type family Array t (ds :: [Nat]) = v | v -> t ds where- Array t '[] = Scalar t- Array Float '[2] = FloatX2- Array Float '[3] = FloatX3- Array Float '[4] = FloatX4- Array Float (d ': ds) = ArrayF (d ': ds)- Array Double (d ': ds) = ArrayD (d ': ds)- Array Int (d ': ds) = ArrayI (d ': ds)- Array Int8 (d ': ds) = ArrayI8 (d ': ds)- Array Int16 (d ': ds) = ArrayI16 (d ': ds)- Array Int32 (d ': ds) = ArrayI32 (d ': ds)- Array Int64 (d ': ds) = ArrayI64 (d ': ds)- Array Word (d ': ds) = ArrayW (d ': ds)- Array Word8 (d ': ds) = ArrayW8 (d ': ds)- Array Word16 (d ': ds) = ArrayW16 (d ': ds)- Array Word32 (d ': ds) = ArrayW32 (d ': ds)- Array Word64 (d ': ds) = ArrayW64 (d ': ds)----- | Specialize scalar type without any arrays-newtype Scalar t = Scalar { _unScalar :: t }- deriving ( Bounded, Enum, Eq, Integral- , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat)-instance Show t => Show (Scalar t) where- show (Scalar t) = "{ " ++ show t ++ " }"--type instance ElemRep (Scalar t) = ElemRep t-type instance ElemPrim (Scalar Float ) = Float#-type instance ElemPrim (Scalar Double) = Double#-type instance ElemPrim (Scalar Int ) = Int#-type instance ElemPrim (Scalar Int8 ) = Int#-type instance ElemPrim (Scalar Int16 ) = Int#-type instance ElemPrim (Scalar Int32 ) = Int#-type instance ElemPrim (Scalar Int64 ) = Int#-type instance ElemPrim (Scalar Word ) = Word#-type instance ElemPrim (Scalar Word8 ) = Word#-type instance ElemPrim (Scalar Word16) = Word#-type instance ElemPrim (Scalar Word32) = Word#-type instance ElemPrim (Scalar Word64) = Word#--deriving instance PrimBytes (Scalar Float)-deriving instance PrimBytes (Scalar Double)-deriving instance PrimBytes (Scalar Int)-deriving instance PrimBytes (Scalar Int8)-deriving instance PrimBytes (Scalar Int16)-deriving instance PrimBytes (Scalar Int32)-deriving instance PrimBytes (Scalar Int64)-deriving instance PrimBytes (Scalar Word)-deriving instance PrimBytes (Scalar Word8)-deriving instance PrimBytes (Scalar Word16)-deriving instance PrimBytes (Scalar Word32)-deriving instance PrimBytes (Scalar Word64)---- | Indexing over scalars is trivial...-instance ElementWise (Idx ('[] :: [Nat])) t (Scalar t) where- (!) x _ = _unScalar x- {-# INLINE (!) #-}- ewmap f = Scalar . f Z . _unScalar- {-# INLINE ewmap #-}- ewgen f = Scalar $ f Z- {-# INLINE ewgen #-}- ewgenA f = Scalar <$> f Z- {-# INLINE ewgenA #-}- ewfoldl f x0 = f Z x0 . _unScalar- {-# INLINE ewfoldl #-}- ewfoldr f x0 x = f Z (_unScalar x) x0- {-# INLINE ewfoldr #-}- elementWise f = fmap Scalar . f . _unScalar- {-# INLINE elementWise #-}- indexWise f = fmap Scalar . f Z . _unScalar- {-# INLINE indexWise #-}- broadcast = Scalar- {-# INLINE broadcast #-}- update _ x _ = Scalar x- {-# INLINE update #-}----- * Array implementations.--- All array implementations have the same structure:--- Array[Type] (element offset :: Int#) (element length :: Int#)--- (content :: ByteArray#)--- All types can also be instantiated with a single scalar value.---data ArrayF (ds :: [Nat]) = ArrayF# Int# Int# ByteArray#- | FromScalarF# Float#-data ArrayD (ds :: [Nat]) = ArrayD# Int# Int# ByteArray#- | FromScalarD# Double#-data ArrayI (ds :: [Nat]) = ArrayI# Int# Int# ByteArray#- | FromScalarI# Int#-data ArrayI8 (ds :: [Nat]) = ArrayI8# Int# Int# ByteArray#- | FromScalarI8# Int#-data ArrayI16 (ds :: [Nat]) = ArrayI16# Int# Int# ByteArray#- | FromScalarI16# Int#-data ArrayI32 (ds :: [Nat]) = ArrayI32# Int# Int# ByteArray#- | FromScalarI32# Int#-data ArrayI64 (ds :: [Nat]) = ArrayI64# Int# Int# ByteArray#- | FromScalarI64# Int#-data ArrayW (ds :: [Nat]) = ArrayW# Int# Int# ByteArray#- | FromScalarW# Word#-data ArrayW8 (ds :: [Nat]) = ArrayW8# Int# Int# ByteArray#- | FromScalarW8# Word#-data ArrayW16 (ds :: [Nat]) = ArrayW16# Int# Int# ByteArray#- | FromScalarW16# Word#-data ArrayW32 (ds :: [Nat]) = ArrayW32# Int# Int# ByteArray#- | FromScalarW32# Word#-data ArrayW64 (ds :: [Nat]) = ArrayW64# Int# Int# ByteArray#- | FromScalarW64# Word#---- * Specialized types--- More efficient data types for small fixed-size tensors-data FloatX2 = FloatX2# Float# Float#-data FloatX3 = FloatX3# Float# Float# Float#-data FloatX4 = FloatX4# Float# Float# Float# Float#---- * Recovering type instances at runtime--- A combination of `ElemType t` and `ArraySize ds` should--- define an instance of `Array t ds` unambiguously.----- | Keep information about the element type instance-data ElemType t- = t ~ Float => ETFloat- | t ~ Double => ETDouble- | t ~ Int => ETInt- | t ~ Int8 => ETInt8- | t ~ Int16 => ETInt16- | t ~ Int32 => ETInt32- | t ~ Int64 => ETInt64- | t ~ Word => ETWord- | t ~ Word8 => ETWord8- | t ~ Word16 => ETWord16- | t ~ Word32 => ETWord32- | t ~ Word64 => ETWord64---- | Keep information about the array dimensionality-data ArraySize (ds :: [Nat])- = ds ~ '[] => ASScalar- | ds ~ '[2] => ASX2- | ds ~ '[3] => ASX3- | ds ~ '[4] => ASX4- | forall n . (ds ~ '[n], 5 <= n) => ASXN- | forall n1 n2 ns . ds ~ (n1 ': n2 ': ns) => ASArray---- | Keep information about the instance behind Array family-data ArrayInstance t (ds :: [Nat])- = ( Array t ds ~ Scalar t, ds ~ '[]) => AIScalar- | forall n ns . ( Array t ds ~ ArrayF ds, ds ~ (n ': ns), t ~ Float ) => AIArrayF- | forall n ns . ( Array t ds ~ ArrayD ds, ds ~ (n ': ns), t ~ Double) => AIArrayD- | forall n ns . ( Array t ds ~ ArrayI ds, ds ~ (n ': ns), t ~ Int ) => AIArrayI- | forall n ns . ( Array t ds ~ ArrayI8 ds, ds ~ (n ': ns), t ~ Int8 ) => AIArrayI8- | forall n ns . ( Array t ds ~ ArrayI16 ds, ds ~ (n ': ns), t ~ Int16 ) => AIArrayI16- | forall n ns . ( Array t ds ~ ArrayI32 ds, ds ~ (n ': ns), t ~ Int32 ) => AIArrayI32- | forall n ns . ( Array t ds ~ ArrayI64 ds, ds ~ (n ': ns), t ~ Int64 ) => AIArrayI64- | forall n ns . ( Array t ds ~ ArrayW ds, ds ~ (n ': ns), t ~ Word ) => AIArrayW- | forall n ns . ( Array t ds ~ ArrayW8 ds, ds ~ (n ': ns), t ~ Word8 ) => AIArrayW8- | forall n ns . ( Array t ds ~ ArrayW16 ds, ds ~ (n ': ns), t ~ Word16) => AIArrayW16- | forall n ns . ( Array t ds ~ ArrayW32 ds, ds ~ (n ': ns), t ~ Word32) => AIArrayW32- | forall n ns . ( Array t ds ~ ArrayW64 ds, ds ~ (n ': ns), t ~ Word64) => AIArrayW64- | ( Array t ds ~ FloatX2, ds ~ '[2], t ~ Float) => AIFloatX2- | ( Array t ds ~ FloatX3, ds ~ '[3], t ~ Float) => AIFloatX3- | ( Array t ds ~ FloatX4, ds ~ '[4], t ~ Float) => AIFloatX4---- | A singleton type used to prove that the given Array family instance--- has a known instance-type ArrayInstanceEvidence t (ds :: [Nat])- = Evidence (ArrayInstanceInference t ds)---class ElemTypeInference t where- -- | Pattern match against result to get specific element type- elemTypeInstance :: ElemType t--class ArraySizeInference ds where- -- | Pattern match agains result to get actual array dimensionality- arraySizeInstance :: ArraySize ds- inferSnocArrayInstance :: (ElemTypeInference t, KnownDim z)- => p t ds -> q z -> ArrayInstanceEvidence t (ds +: z)- inferConsArrayInstance :: (ElemTypeInference t, KnownDim z)- => q z -> p t ds -> ArrayInstanceEvidence t (z :+ ds)- inferInitArrayInstance :: ElemTypeInference t- => p t ds -> ArrayInstanceEvidence t (Init ds)----- | Use this typeclass constraint in libraries functions if there is a need--- to select an instance of Array famility at runtime.--- Combination of `elemTypeInstance` and `arraySizeInstance` allows--- to bring into typechecker's scope any specific typeclass instance-type ArrayInstanceInference t ds = (ElemTypeInference t, ArraySizeInference ds)----instance ElemTypeInference Float where- elemTypeInstance = ETFloat-instance ElemTypeInference Double where- elemTypeInstance = ETDouble-instance ElemTypeInference Int where- elemTypeInstance = ETInt-instance ElemTypeInference Int8 where- elemTypeInstance = ETInt8-instance ElemTypeInference Int16 where- elemTypeInstance = ETInt16-instance ElemTypeInference Int32 where- elemTypeInstance = ETInt32-instance ElemTypeInference Int64 where- elemTypeInstance = ETInt64-instance ElemTypeInference Word where- elemTypeInstance = ETWord-instance ElemTypeInference Word8 where- elemTypeInstance = ETWord8-instance ElemTypeInference Word16 where- elemTypeInstance = ETWord16-instance ElemTypeInference Word32 where- elemTypeInstance = ETWord32-instance ElemTypeInference Word64 where- elemTypeInstance = ETWord64--instance ArraySizeInference '[] where- arraySizeInstance = ASScalar- {-# INLINE arraySizeInstance #-}- inferSnocArrayInstance _ _ = Evidence- {-# INLINE inferSnocArrayInstance #-}- inferConsArrayInstance _ _ = Evidence- {-# INLINE inferConsArrayInstance #-}- inferInitArrayInstance _ = error "Init -- empty type-level list"- {-# INLINE inferInitArrayInstance #-}--instance KnownDim d => ArraySizeInference '[d] where- arraySizeInstance = case dimVal' @d of- 0 -> unsafeCoerce# ASScalar- 1 -> unsafeCoerce# ASScalar- 2 -> unsafeCoerce# ASX2- 3 -> unsafeCoerce# ASX3- 4 -> unsafeCoerce# ASX4- _ -> case (unsafeCoerce# Refl :: (5 <=? d) :~: 'True) of Refl -> ASXN- {-# INLINE arraySizeInstance #-}- inferSnocArrayInstance _ _ = Evidence- {-# INLINE inferSnocArrayInstance #-}- inferConsArrayInstance _ _ = Evidence- {-# INLINE inferConsArrayInstance #-}- inferInitArrayInstance _ = Evidence- {-# INLINE inferInitArrayInstance #-}--instance KnownDim d1 => ArraySizeInference '[d1, d2] where- arraySizeInstance = ASArray- {-# INLINE arraySizeInstance #-}- inferSnocArrayInstance _ _ = Evidence- {-# INLINE inferSnocArrayInstance #-}- inferConsArrayInstance _ _ = Evidence- {-# INLINE inferConsArrayInstance #-}- inferInitArrayInstance _ = Evidence- {-# INLINE inferInitArrayInstance #-}---instance ArraySizeInference (d1 ': d2 ': d3 ': ds) where- arraySizeInstance = ASArray- {-# INLINE arraySizeInstance #-}- -- I know that for dimensionality > 2 all instances are the same.- -- Hence this dirty hack should work.- -- I have to change this when I have customized N*M instances- inferSnocArrayInstance p q = unsafeCoerce# (inferConsArrayInstance q p)- {-# INLINE inferSnocArrayInstance #-}- inferConsArrayInstance _ _ = Evidence- {-# INLINE inferConsArrayInstance #-}- -- I know that for dimensionality > 2 all instances are the same.- -- Hence this dirty hack should work.- -- I have to change this when I have customized N*M instances- inferInitArrayInstance p = unsafeCoerce# (inferConsArrayInstance (Proxy @3) p)- {-# INLINE inferInitArrayInstance #-}----getArrayInstance :: forall t (ds :: [Nat])- . ArrayInstanceInference t ds- => ArrayInstance t ds-getArrayInstance = case (elemTypeInstance @t, arraySizeInstance @ds) of- (ETFloat , ASScalar) -> AIScalar- (ETDouble , ASScalar) -> AIScalar- (ETInt , ASScalar) -> AIScalar- (ETInt8 , ASScalar) -> AIScalar- (ETInt16 , ASScalar) -> AIScalar- (ETInt32 , ASScalar) -> AIScalar- (ETInt64 , ASScalar) -> AIScalar- (ETWord , ASScalar) -> AIScalar- (ETWord8 , ASScalar) -> AIScalar- (ETWord16 , ASScalar) -> AIScalar- (ETWord32 , ASScalar) -> AIScalar- (ETWord64 , ASScalar) -> AIScalar-- (ETFloat , ASX2) -> AIFloatX2- (ETDouble , ASX2) -> AIArrayD- (ETInt , ASX2) -> AIArrayI- (ETInt8 , ASX2) -> AIArrayI8- (ETInt16 , ASX2) -> AIArrayI16- (ETInt32 , ASX2) -> AIArrayI32- (ETInt64 , ASX2) -> AIArrayI64- (ETWord , ASX2) -> AIArrayW- (ETWord8 , ASX2) -> AIArrayW8- (ETWord16 , ASX2) -> AIArrayW16- (ETWord32 , ASX2) -> AIArrayW32- (ETWord64 , ASX2) -> AIArrayW64-- (ETFloat , ASX3) -> AIFloatX3- (ETDouble , ASX3) -> AIArrayD- (ETInt , ASX3) -> AIArrayI- (ETInt8 , ASX3) -> AIArrayI8- (ETInt16 , ASX3) -> AIArrayI16- (ETInt32 , ASX3) -> AIArrayI32- (ETInt64 , ASX3) -> AIArrayI64- (ETWord , ASX3) -> AIArrayW- (ETWord8 , ASX3) -> AIArrayW8- (ETWord16 , ASX3) -> AIArrayW16- (ETWord32 , ASX3) -> AIArrayW32- (ETWord64 , ASX3) -> AIArrayW64-- (ETFloat , ASX4) -> AIFloatX4- (ETDouble , ASX4) -> AIArrayD- (ETInt , ASX4) -> AIArrayI- (ETInt8 , ASX4) -> AIArrayI8- (ETInt16 , ASX4) -> AIArrayI16- (ETInt32 , ASX4) -> AIArrayI32- (ETInt64 , ASX4) -> AIArrayI64- (ETWord , ASX4) -> AIArrayW- (ETWord8 , ASX4) -> AIArrayW8- (ETWord16 , ASX4) -> AIArrayW16- (ETWord32 , ASX4) -> AIArrayW32- (ETWord64 , ASX4) -> AIArrayW64-- (ETFloat , ASXN) -> unsafeCoerce# (AIArrayF :: ArrayInstance Float '[5])- (ETDouble , ASXN) -> AIArrayD- (ETInt , ASXN) -> AIArrayI- (ETInt8 , ASXN) -> AIArrayI8- (ETInt16 , ASXN) -> AIArrayI16- (ETInt32 , ASXN) -> AIArrayI32- (ETInt64 , ASXN) -> AIArrayI64- (ETWord , ASXN) -> AIArrayW- (ETWord8 , ASXN) -> AIArrayW8- (ETWord16 , ASXN) -> AIArrayW16- (ETWord32 , ASXN) -> AIArrayW32- (ETWord64 , ASXN) -> AIArrayW64-- (ETFloat , ASArray) -> AIArrayF- (ETDouble , ASArray) -> AIArrayD- (ETInt , ASArray) -> AIArrayI- (ETInt8 , ASArray) -> AIArrayI8- (ETInt16 , ASArray) -> AIArrayI16- (ETInt32 , ASArray) -> AIArrayI32- (ETInt64 , ASArray) -> AIArrayI64- (ETWord , ASArray) -> AIArrayW- (ETWord8 , ASArray) -> AIArrayW8- (ETWord16 , ASArray) -> AIArrayW16- (ETWord32 , ASArray) -> AIArrayW32- (ETWord64 , ASArray) -> AIArrayW64---- | Given element type instance and proper dimension list,--- infer a corresponding array instance-inferArrayInstance :: forall t ds- . ( FiniteList ds- , KnownDims ds- , ElemTypeInference t- )- => ArrayInstanceEvidence t ds-inferArrayInstance = case tList @_ @ds of- TLEmpty -> Evidence- TLCons _ TLEmpty -> Evidence- TLCons _ (TLCons _ TLEmpty) -> Evidence- TLCons _ (TLCons _ (TLCons _ _)) -> Evidence---_suppressHlintUnboxedTuplesWarning :: () -> (# (), () #)-_suppressHlintUnboxedTuplesWarning = undefined
− src/Numeric/Array/Family/Array.h
@@ -1,305 +0,0 @@------------------------------------------------------------------------------------- * Utility functions------------------------------------------------------------------------------------- | Do something in a loop for int i from 0 to n-loop1# :: Int# -> (Int# -> State# s -> State# s) -> State# s -> State# s-loop1# n f = loop0 0#- where- loop0 i s | isTrue# (i ==# n) = s- | otherwise = case f i s of s1 -> loop0 (i +# 1#) s1-{-# INLINE loop1# #-}----- | Do something in a loop for int i from 0 to n-loop1a# :: Int# -> (Int# -> a -> a) -> a -> a-loop1a# n f = loop0 0#- where- loop0 i s | isTrue# (i ==# n) = s- | otherwise = s `seq` case f i s of s1 -> s1 `seq` loop0 (i +# 1#) s1-{-# INLINE loop1a# #-}----- | Treat a single number as an array-broadcastArray :: EL_TYPE_BOXED -> ARR_TYPE ds-broadcastArray (EL_CONSTR x) = ARR_FROMSCALAR x-{-# INLINE broadcastArray #-}---- | Accumulates only idempotent operations!--- Being applied to FromScalars, executes only once!-accumV2 :: (EL_TYPE_PRIM-> EL_TYPE_PRIM -> a -> a)- -> ARR_TYPE ds -> ARR_TYPE ds -> a -> a-accumV2 f (ARR_FROMSCALAR a)- (ARR_FROMSCALAR b) = f a b-accumV2 f (ARR_CONSTR offset n a)- (ARR_FROMSCALAR b) = loop1a# n- (\i -> f (INDEX_ARRAY a (offset +# i)) b)-accumV2 f (ARR_FROMSCALAR a)- (ARR_CONSTR offset n b) = loop1a# n- (\i -> f a (INDEX_ARRAY b (offset +# i)))-accumV2 f (ARR_CONSTR offsetA n a)- (ARR_CONSTR offsetB _ b) = loop1a# n- (\i -> f (INDEX_ARRAY a (offsetA +# i))- (INDEX_ARRAY b (offsetB +# i))- )--mapV :: (EL_TYPE_PRIM -> EL_TYPE_PRIM) -> ARR_TYPE ds -> ARR_TYPE ds-mapV f (ARR_FROMSCALAR x) = ARR_FROMSCALAR (f x)-mapV f (ARR_CONSTR offset n a) = case runRW#- ( \s0 -> case newByteArray# (n *# EL_SIZE) s0 of- (# s1, marr #) -> case loop1# n- (\i ss -> case f (INDEX_ARRAY a (offset +# i)) of- r -> WRITE_ARRAY marr i r ss- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> ARR_CONSTR 0# n r-{-# INLINE mapV #-}--zipV :: (EL_TYPE_PRIM -> EL_TYPE_PRIM -> EL_TYPE_PRIM)- -> ARR_TYPE ds -> ARR_TYPE ds -> ARR_TYPE ds-zipV f (ARR_FROMSCALAR a)- (ARR_FROMSCALAR b) = ARR_FROMSCALAR (f a b)-zipV f x (ARR_FROMSCALAR b) = mapV (`f` b) x-zipV f (ARR_FROMSCALAR a) y = mapV (f a) y-zipV f (ARR_CONSTR offsetA n a)- (ARR_CONSTR offsetB _ b) = case runRW#- ( \s0 -> case newByteArray# (n *# EL_SIZE ) s0 of- (# s1, marr #) -> case loop1# n- (\i ss -> case f (INDEX_ARRAY a (offsetA +# i))- (INDEX_ARRAY b (offsetB +# i)) of- r -> WRITE_ARRAY marr i r ss- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> ARR_CONSTR 0# n r-{-# INLINE zipV #-}--------------------------------------------------------------------------------------- * Instances--------------------------------------------------------------------------------------wr :: ARR_TYPE (ds :: [Nat]) -> Int# -> Int#- -> (MutableByteArray# RealWorld -> State# RealWorld -> State# RealWorld)- -> ARR_TYPE ds-wr _ bs n ff = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case ff marr s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> ARR_CONSTR 0# n r-{-# INLINE wr #-}--data ArrayUpdate# (f :: * -> *) s- = AU# Int# !(f (MutableByteArray# s -> State# s -> State# s))--instance Dimensions ds => ElementWise (Idx ds) EL_TYPE_BOXED (ARR_TYPE (ds :: [Nat])) where- (!) (ARR_CONSTR off _ a) i- = case fromEnum i of I# j -> EL_CONSTR (INDEX_ARRAY a (off +# j))- (!) (ARR_FROMSCALAR x) _ = EL_CONSTR x- {-# INLINE (!) #-}-- broadcast (EL_CONSTR x) = ARR_FROMSCALAR x- {-# INLINE broadcast #-}-- ewmap f x@(ARR_CONSTR offset n arr) = case runRW#- (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of- (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)- ( \ii off s -> case f ii (EL_CONSTR (INDEX_ARRAY arr (offset +# off))) of- (EL_CONSTR r) -> WRITE_ARRAY marr off r s- ) 0# 1# s1 of- s3 -> unsafeFreezeByteArray# marr s3- ) of (# _, r #) -> ARR_CONSTR 0# n r- ewmap f x@(ARR_FROMSCALAR scalVal) = case runRW#- (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of- (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)- ( \ii off s -> case f ii (EL_CONSTR scalVal) of- (EL_CONSTR r) -> WRITE_ARRAY marr off r s- ) 0# 1# s1 of- s3 -> unsafeFreezeByteArray# marr s3- ) of (# _, r #) -> ARR_CONSTR 0# n r- where- n = case totalDim x of I# d -> d- {-# INLINE ewmap #-}-- ewgen f = case runRW#- (\s0 -> case newByteArray# (n *# EL_SIZE) s0 of- (# s1, marr #) -> case overDim_# (dim `inSpaceOf` x)- ( \ii off s -> case f ii of- (EL_CONSTR r) -> WRITE_ARRAY marr off r s- ) 0# 1# s1 of- s3 -> unsafeFreezeByteArray# marr s3- ) of (# _, r #) -> ARR_CONSTR 0# n r- where- x = undefined :: ARR_TYPE ds- n = case totalDim x of I# d -> d- {-# INLINE ewgen #-}-- ewgenA f- = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of- AU# _ ff -> wr x bs n <$> ff- where- g ds (AU# i ff) = AU# ( i +# 1# )- $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))- <$> f ds <*> ff- x = undefined :: ARR_TYPE ds- n = case totalDim x of I# d -> d- bs = n *# EL_SIZE-- ewfoldr f v0 x@(ARR_CONSTR offset _ arr)- = foldDimReverse (dim `inSpaceOf` x)- (\ii off -> f ii (EL_CONSTR (INDEX_ARRAY arr off))) offset 1# v0- ewfoldr f v0 x@(ARR_FROMSCALAR scalVal) = foldDimReverseIdx (dim `inSpaceOf` x)- (\ii -> f ii (EL_CONSTR scalVal)) v0- {-# INLINE ewfoldr #-}-- ewfoldl f v0 x@(ARR_CONSTR offset _ arr)- = foldDim (dim `inSpaceOf` x)- (\ii off v -> f ii v (EL_CONSTR (INDEX_ARRAY arr off))) offset 1# v0- ewfoldl f v0 x@(ARR_FROMSCALAR scalVal) = foldDimIdx (dim `inSpaceOf` x)- (\ii v -> f ii v (EL_CONSTR scalVal)) v0- {-# INLINE ewfoldl #-}-- indexWise f x@(ARR_CONSTR offset n arr)- = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of- AU# _ ff -> wr x bs n <$> ff- where- g ds (AU# i ff) = AU# ( i +# 1# )- $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))- <$> f ds (EL_CONSTR (INDEX_ARRAY arr (offset +# i))) <*> ff- bs = n *# EL_SIZE-- indexWise f x@(ARR_FROMSCALAR scalVal)- = case foldDimIdx (dim `inSpaceOf` x) g (AU# 0# (pure (\_ s -> s))) of- AU# _ ff -> wr x bs n <$> ff- where- n = case totalDim x of I# d -> d- g ds (AU# i ff) = AU# ( i +# 1# )- $ (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))- <$> f ds (EL_CONSTR scalVal) <*> ff- bs = n *# EL_SIZE--- elementWise f x@(ARR_CONSTR offset n arr) =- wr x bs n <$> loop1a# n g (pure (\_ s -> s))- where- g i ff = (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))- <$> f (EL_CONSTR (INDEX_ARRAY arr (offset +# i))) <*> ff- bs = n *# EL_SIZE- elementWise f x@(ARR_FROMSCALAR scalVal) =- wr x bs n <$> loop1a# n g (pure (\_ s -> s))- where- fa = f (EL_CONSTR scalVal)- n = case totalDim x of I# d -> d- g i ff = (\(EL_CONSTR z) u a s -> WRITE_ARRAY a i z (u a s))- <$> fa <*> ff- bs = n *# EL_SIZE-- update ei (EL_CONSTR y) (ARR_CONSTR off len arr)- | I# i <- fromEnum ei- = case runRW#- ( \s0 -> case newByteArray# ( len *# EL_SIZE ) s0 of- (# s1, marr #) -> case copyByteArray# arr (off *# EL_SIZE) marr 0# (len *# EL_SIZE) s1 of- s2 -> case WRITE_ARRAY marr i y s2 of- s3 -> unsafeFreezeByteArray# marr s3- ) of (# _, r #) -> ARR_CONSTR 0# len r--- update ei (EL_CONSTR y) x@(ARR_FROMSCALAR scalVal)- | I# i <- fromEnum ei- , I# len <- totalDim x- = case runRW#- ( \s0 -> case newByteArray# ( len *# EL_SIZE ) s0 of- (# s1, marr #) -> case loop1# len (\j -> WRITE_ARRAY marr j scalVal) s1 of- s2 -> case WRITE_ARRAY marr i y s2 of- s3 -> unsafeFreezeByteArray# marr s3- ) of (# _, r #) -> ARR_CONSTR 0# len r--instance Dimensions ds- => Show (ARR_TYPE (ds :: [Nat])) where- show x = case dim @ds of- D -> "{ " ++ show (x ! Z) ++ " }"- Dn :* D -> ('{' :) . drop 1 $- foldr (\i s -> ", " ++ show (x ! i) ++ s) " }"- [minBound .. maxBound]- (Dn :: Dim (n :: Nat)) :* (Dn :: Dim (m :: Nat)) :* (_ :: Dim (dss :: [Nat])) ->- case inferDropNDimensions @2 @ds of- Evidence ->- let loopInner :: Idx dss -> Idx '[n,m] -> String- loopInner ods (n:!m:!_) = ('{' :) . drop 2 $- foldr (\i ss -> '\n':- foldr (\j s ->- ", " ++ show (x ! (i :! j :! ods)) ++ s- ) ss [1..m]- ) " }" [1..n]- loopOuter :: Idx dss -> String -> String- loopOuter Z s = "\n" ++ loopInner Z maxBound ++ s- loopOuter ds s = "\n(i j" ++ drop 3 (show ds) ++ "):\n"- ++ loopInner ds maxBound ++ s- in drop 1 $ foldr loopOuter "" [minBound..maxBound]--instance Eq (ARR_TYPE ds) where- a == b = accumV2 (\x y r -> r && isTrue# (OP_EQ x y)) a b True- {-# INLINE (==) #-}- a /= b = accumV2 (\x y r -> r || isTrue# (OP_NE x y)) a b False- {-# INLINE (/=) #-}----- | Implement partial ordering for `>`, `<`, `>=`, `<=`--- and lexicographical ordering for `compare`-instance Ord (ARR_TYPE ds) where- a > b = accumV2 (\x y r -> r && isTrue# (OP_GT x y)) a b True- {-# INLINE (>) #-}- a < b = accumV2 (\x y r -> r && isTrue# (OP_LT x y)) a b True- {-# INLINE (<) #-}- a >= b = accumV2 (\x y r -> r && isTrue# (OP_GE x y)) a b True- {-# INLINE (>=) #-}- a <= b = accumV2 (\x y r -> r && isTrue# (OP_LE x y)) a b True- {-# INLINE (<=) #-}- -- | Compare lexicographically- compare a b = accumV2 (\x y r -> r `mappend`- if isTrue# (OP_GT x y)- then GT- else if isTrue# (OP_LT x y)- then LT- else EQ- ) a b EQ- {-# INLINE compare #-}- -- | Element-wise minimum- min = zipV (\x y -> if isTrue# (OP_GT x y) then y else x)- {-# INLINE min #-}- -- | Element-wise maximum- max = zipV (\x y -> if isTrue# (OP_GT x y) then x else y)- {-# INLINE max #-}---type instance ElemRep (ARR_TYPE ds) = EL_RUNTIME_REP-type instance ElemPrim (ARR_TYPE ds) = EL_TYPE_PRIM-instance Dimensions ds => PrimBytes (ARR_TYPE ds) where- toBytes (ARR_CONSTR off size a) = (# off, size, a #)- toBytes (ARR_FROMSCALAR x) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop1# n- (\i -> WRITE_ARRAY marr i x- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> (# 0#, n, r #)- where- n = case totalDim (undefined :: ArrayF ds) of I# d -> d- bs = n *# EL_SIZE- {-# INLINE toBytes #-}- fromBytes (# off, size, a #) = ARR_CONSTR off size a- {-# INLINE fromBytes #-}- byteSize x = case totalDim x of- I# d -> EL_SIZE *# d- {-# INLINE byteSize #-}- byteAlign _ = EL_ALIGNMENT- {-# INLINE byteAlign #-}- elementByteSize _ = EL_SIZE- {-# INLINE elementByteSize #-}- ix i (ARR_CONSTR off _ a) = INDEX_ARRAY a (off +# i)- ix _ (ARR_FROMSCALAR x) = x- {-# INLINE ix #-}
− src/Numeric/Array/Family/ArrayD.hs
@@ -1,408 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayD--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayD () where---import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Double (..), Int (..),- RuntimeRep (..), isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.DataFrame.Type-import Numeric.Dimensions-import Numeric.Dimensions.Traverse-import Numeric.TypeLits-import Numeric.Matrix.Type---#include "MachDeps.h"-#define ARR_TYPE ArrayD-#define ARR_FROMSCALAR FromScalarD#-#define ARR_CONSTR ArrayD#-#define EL_TYPE_BOXED Double-#define EL_TYPE_PRIM Double#-#define EL_RUNTIME_REP 'DoubleRep-#define EL_CONSTR D#-#define EL_SIZE SIZEOF_HSDOUBLE#-#define EL_ALIGNMENT ALIGNMENT_HSDOUBLE#-#define EL_ZERO 0.0##-#define EL_ONE 1.0##-#define EL_MINUS_ONE -1.0##-#define INDEX_ARRAY indexDoubleArray#-#define WRITE_ARRAY writeDoubleArray#-#define OP_EQ (==##)-#define OP_NE (/=##)-#define OP_GT (>##)-#define OP_GE (>=##)-#define OP_LT (<##)-#define OP_LE (<=##)-#define OP_PLUS (+##)-#define OP_MINUS (-##)-#define OP_TIMES (*##)-#define OP_NEGATE negateDouble#-#include "Array.h"---instance Num (ArrayD ds) where- (+) = zipV (+##)- {-# INLINE (+) #-}- (-) = zipV (-##)- {-# INLINE (-) #-}- (*) = zipV (*##)- {-# INLINE (*) #-}- negate = mapV negateDouble#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (x >=## 0.0##)- then x- else negateDouble# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (x >## 0.0##)- then 1.0##- else if isTrue# (x <## 0.0##)- then -1.0##- else 0.0##- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Fractional (ArrayD ds) where- (/) = zipV (/##)- {-# INLINE (/) #-}- recip = mapV (1.0## /##)- {-# INLINE recip #-}- fromRational = broadcastArray . fromRational- {-# INLINE fromRational #-}---instance Floating (ArrayD ds) where- pi = broadcastArray pi- {-# INLINE pi #-}- exp = mapV expDouble#- {-# INLINE exp #-}- log = mapV logDouble#- {-# INLINE log #-}- sqrt = mapV sqrtDouble#- {-# INLINE sqrt #-}- sin = mapV sinDouble#- {-# INLINE sin #-}- cos = mapV cosDouble#- {-# INLINE cos #-}- tan = mapV tanDouble#- {-# INLINE tan #-}- asin = mapV asinDouble#- {-# INLINE asin #-}- acos = mapV acosDouble#- {-# INLINE acos #-}- atan = mapV atanDouble#- {-# INLINE atan #-}- sinh = mapV sinDouble#- {-# INLINE sinh #-}- cosh = mapV coshDouble#- {-# INLINE cosh #-}- tanh = mapV tanhDouble#- {-# INLINE tanh #-}- (**) = zipV (**##)- {-# INLINE (**) #-}-- logBase = zipV (\x y -> logDouble# y /## logDouble# x)- {-# INLINE logBase #-}- asinh = mapV (\x -> logDouble# (x +##- sqrtDouble# (1.0## +## x *## x)))- {-# INLINE asinh #-}- acosh = mapV (\x -> case x +## 1.0## of- y -> logDouble# ( x +## y *##- sqrtDouble# ((x -## 1.0##) /## y)- )- )- {-# INLINE acosh #-}- atanh = mapV (\x -> 0.5## *##- logDouble# ((1.0## +## x) /## (1.0## -## x)))- {-# INLINE atanh #-}---instance (KnownNat n, KnownNat m, ArrayD '[n,m] ~ Array Double '[n,m], 2 <= n, 2 <= m)- => MatrixCalculus Double n m where- transpose (KnownDataFrame (ArrayD# offs nm arr)) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop2# n m- (\i j s' -> writeDoubleArray# marr (j +# m *# i)- (indexDoubleArray# arr (offs +# j *# n +# i)) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, nm, r #)- where- n = case fromInteger $ natVal (Proxy @n) of I# np -> np- m = case fromInteger $ natVal (Proxy @m) of I# mp -> mp- bs = n *# m *# EL_SIZE- transpose (KnownDataFrame (FromScalarD# x)) = unsafeCoerce# $ FromScalarD# x--instance ( KnownDim n, ArrayD '[n,n] ~ Array Double '[n,n] )- => SquareMatrixCalculus Double n where- eye = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop1# n- (\j s' -> writeDoubleArray# marr (j *# n1) 1.0## s'- ) (setByteArray# marr 0# bs 0# s1) of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)- where- n1 = n +# 1#- n = case dimVal' @n of I# np -> np- bs = n *# n *# EL_SIZE- {-# INLINE eye #-}- diag (KnownDataFrame (Scalar (D# v))) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop1# n- (\j s' -> writeDoubleArray# marr (j *# n1) v s'- ) (setByteArray# marr 0# bs 0# s1) of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)- where- n1 = n +# 1#- n = case dimVal' @n of I# np -> np- bs = n *# n *# EL_SIZE- {-# INLINE diag #-}--- det (KnownDataFrame (ArrayD# off nsqr arr)) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, mat #) -> case newByteArray#- (n *# EL_SIZE)- (copyByteArray# arr offb mat 0# bs s1) of- (# s2, vec #) ->- let f i x s | isTrue# (i >=# n) = (# s, x #)- | otherwise =- let !(# s' , j #) = maxInRowRem# n n i mat s- !(# s'', x' #) = if isTrue# (i /=# j)- then (# swapCols# n i j vec mat s'- , negateDouble# x #)- else (# s', x #)- !(# s''', y #) = clearRowEnd# n n i mat s''- in if isTrue# (0.0## ==## y)- then (# s''', 0.0## #)- else f (i +# 1#) (x' *## y) s'''- in f 0# 1.0## s2- ) of (# _, r #) -> D# r- where- n = case dimVal' @n of I# np -> np- offb = off *# EL_SIZE- bs = nsqr *# EL_SIZE- det (KnownDataFrame (FromScalarD# _)) = 0- {-# INLINE det #-}---- trace (KnownDataFrame (ArrayD# off nsqr a)) = KnownDataFrame (Scalar (D# (loop' 0# 0.0##)))- where- n1 = n +# 1#- n = case dimVal' @n of I# np -> np- loop' i acc | isTrue# (i ># nsqr) = acc- | otherwise = loop' (i +# n1)- (indexDoubleArray# a (off +# i) +## acc)- trace (KnownDataFrame (FromScalarD# x)) = KnownDataFrame (Scalar (D# (x *## n)))- where- n = case fromIntegral (dimVal' @n) of D# np -> np- {-# INLINE trace #-}----instance (KnownNat n, ArrayD '[n,n] ~ Array Double '[n,n], 2 <= n) => MatrixInverse Double n where- inverse (KnownDataFrame (ArrayD# offs nsqr arr)) = case runRW#- ( \s0 -> case newByteArray# (bs *# 2#) s0 of- (# s1, mat #) -> case newByteArray# (vs *# 2#)- -- copy original matrix to the top of an augmented matrix- (loop1# n (\i s -> writeDoubleArray# mat- (i *# nn +# i +# n) 1.0##- (copyByteArray# arr (offb +# i *# vs)- mat (2# *# i *# vs) vs s))- (setByteArray# mat 0# (bs *# 2#) 0# s1)- ) of- (# s2, vec #) ->- let f i s | isTrue# (i >=# n) = s- | otherwise =- let !(# s' , j #) = maxInRowRem# nn n i mat s- s'' = if isTrue# (i /=# j) then swapCols# nn i j vec mat s'- else s'- !(# s''', _ #) = clearRowAll# nn n i mat s''- in f (i +# 1#) s'''- in unsafeFreezeByteArray# mat- ( shrinkMutableByteArray# mat bs- (-- copy inverse matrix from the augmented part- loop1# n (\i s ->- copyMutableByteArray# mat- (2# *# i *# vs +# vs)- mat (i *# vs) vs s)- (f 0# s2)- )- )- ) of (# _, r #) -> KnownDataFrame (ArrayD# 0# nsqr r)- where- nn = 2# *# n- n = case fromInteger $ natVal (Proxy @n) of I# np -> np- vs = n *# EL_SIZE- bs = n *# n *# EL_SIZE- offb = offs *# EL_SIZE- inverse (KnownDataFrame (FromScalarD# _)) = error "Cannot take inverse of a degenerate matrix"----------------------------------------------------------------------------------- Helpers---------------------------------------------------------------------------------- #ifndef UNSAFE_INDICES--- | isTrue# ( (i ># dim# _x)--- `orI#` (i <=# 0#)--- ) = error $ "Bad index " ++--- show (I# i) ++ " for " ++ show (dim _x) ++ "D vector"--- | otherwise--- #endif----- | Swap columns i and j. Does not check if i or j is larger than matrix width m-swapCols# :: Int# -- n- -> Int# -- ith column to swap- -> Int# -- jth column to swap- -> MutableByteArray# s -- buffer byte array of length of n elems- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> State# s -- next state-swapCols# n i j vec mat s0 =- -- copy ith column to bugger vec- case copyMutableByteArray# mat (i *# bs) vec 0# bs s0 of- s1 -> case copyMutableByteArray# mat (j *# bs) mat (i *# bs) bs s1 of- s2 -> copyMutableByteArray# vec 0# mat (j *# bs) bs s2- where- bs = n *# EL_SIZE---- | Starting from i-th row and i+1-th column, substract a multiple of i-th column from i+1 .. m columns,--- such that there are only zeroes in i-th row and i+1..m columns elements.-clearRowEnd# :: Int# -- n- -> Int# -- m- -> Int# -- ith column to remove from all others- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> (# State# s, Double# #) -- next state and a diagonal element-clearRowEnd# n m i mat s0 = (# loop' (i +# 1#) s1, y' #)- where- y0 = (n +# 1#) *# i +# 1# -- first element in source column- !(# s1, y' #) = readDoubleArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero- yrc = 1.0## /## y'- n' = n -# i -# 1#- loop' k s | isTrue# (k >=# m) = s- | otherwise = loop' (k +# 1#)- ( let x0 = k *# n +# i- !(# s', a' #) = readDoubleArray# mat x0 s- s'' = writeDoubleArray# mat x0 0.0## s'- a = a' *## yrc- in multNRem# n' (x0 +# 1#) y0 a mat s''- )---- | Substract a multiple of i-th column from 0 .. i-1 and i+1 .. m columns,--- such that there are only zeroes in i-th row everywhere except i-th column--- Assuming that elements in 0..i-1 columnts and in i-th row are zeroes, so they do not affect other columns.--- After all columns updated, divide i-th row by its diagonal element, so (i,i) element has 1.-clearRowAll# :: Int# -- n- -> Int# -- m- -> Int# -- ith column to remove from all others- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> (# State# s, Double# #) -- next state and a diagonal element-clearRowAll# n m i mat s0 = (# divLoop (i +# 1#)- (writeDoubleArray# mat ((n +# 1#) *# i) 1.0##- (loop' 0# i (loop' (i +# 1#) m s1))), y' #)- where- y0 = (n +# 1#) *# i +# 1# -- first element in source column- !(# s1, y' #) = readDoubleArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero- yrc = 1.0## /## y'- n' = n -# i -# 1#- loop' k km s | isTrue# (k >=# km) = s- | otherwise = loop' (k +# 1#) km- ( let x0 = k *# n +# i- !(# s', a' #) = readDoubleArray# mat x0 s- s'' = writeDoubleArray# mat x0 0.0## s'- a = a' *## yrc- in multNRem# n' (x0 +# 1#) y0 a mat s''- )- divLoop k s | isTrue# (k >=# n) = s- | otherwise = divLoop (k +# 1#)- ( let x0 = n *# i +# k- !(# s', x #) = readDoubleArray# mat x0 s- in writeDoubleArray# mat x0 (x *## yrc) s'- )----- | Remove a multiple of one row from another one.--- do: xi = xi - yi*a-multNRem# :: Int# -- n - nr of elements to go through- -> Int# -- start idx of x (update)- -> Int# -- start idx of y (read)- -> Double# -- multiplier a- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> State# s -- next state-multNRem# 0# _ _ _ _ s = s-multNRem# n x0 y0 a mat s = multNRem# (n -# 1#) (x0 +# 1#) (y0 +# 1#) a mat- ( case readDoubleArray# mat y0 s of- (# s1, y #) -> case readDoubleArray# mat x0 s1 of- (# s2, x #) -> writeDoubleArray# mat x0 (x -## y *## a) s2- )------ | Gives index of maximum (absolute) element in i-th row, starting from i-th element only.--- If i >= m then returns i.-maxInRowRem# :: Int# -- n- -> Int# -- m- -> Int# -- ith column to start to search for and a row to look in- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> (# State# s, Int# #) -- next state-maxInRowRem# n m i mat s0 = loop' i (abs# v) i s1- where- !(# s1, v #) = readDoubleArray# mat ((n +# 1#) *# i) s0- abs# x = if isTrue# (x >=## 0.0##) then x else negateDouble# x- loop' ok ov k s | isTrue# (k >=# m) = (# s, ok #)- | otherwise = case readDoubleArray# mat (n *# k +# i) s of- (# s', v' #) -> if isTrue# (abs# v' >## ov)- then loop' k (abs# v') (k +# 1#) s'- else loop' ok ov (k +# 1#) s'---- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1-loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s)- -> State# s -> State# s-loop2# n m f = loop0 0# 0#- where- loop0 i j s | isTrue# (j ==# m) = s- | isTrue# (i ==# n) = loop0 0# (j +# 1#) s- | otherwise = case f i j s of s1 -> loop0 (i +# 1#) j s1-{-# INLINE loop2# #-}
− src/Numeric/Array/Family/ArrayF.hs
@@ -1,412 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayF--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayF () where----import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Float (..), Int (..),- RuntimeRep (..), isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.DataFrame.Type-import Numeric.Dimensions-import Numeric.Dimensions.Traverse-import Numeric.TypeLits-import Numeric.Matrix.Type--#include "MachDeps.h"-#define ARR_TYPE ArrayF-#define ARR_FROMSCALAR FromScalarF#-#define ARR_CONSTR ArrayF#-#define EL_TYPE_BOXED Float-#define EL_TYPE_PRIM Float#-#define EL_RUNTIME_REP 'FloatRep-#define EL_CONSTR F#-#define EL_SIZE SIZEOF_HSFLOAT#-#define EL_ALIGNMENT ALIGNMENT_HSFLOAT#-#define EL_ZERO 0.0#-#define EL_ONE 1.0#-#define EL_MINUS_ONE -1.0#-#define INDEX_ARRAY indexFloatArray#-#define WRITE_ARRAY writeFloatArray#-#define OP_EQ eqFloat#-#define OP_NE neFloat#-#define OP_GT gtFloat#-#define OP_GE geFloat#-#define OP_LT ltFloat#-#define OP_LE leFloat#-#define OP_PLUS plusFloat#-#define OP_MINUS minusFloat#-#define OP_TIMES timesFloat#-#define OP_NEGATE negateFloat#-#include "Array.h"---instance Num (ArrayF ds) where- (+) = zipV plusFloat#- {-# INLINE (+) #-}- (-) = zipV minusFloat#- {-# INLINE (-) #-}- (*) = zipV timesFloat#- {-# INLINE (*) #-}- negate = mapV negateFloat#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (geFloat# x 0.0#)- then x- else negateFloat# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (gtFloat# x 0.0#)- then 1.0#- else if isTrue# (ltFloat# x 0.0#)- then -1.0#- else 0.0#- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Fractional (ArrayF ds) where- (/) = zipV divideFloat#- {-# INLINE (/) #-}- recip = mapV (divideFloat# 1.0#)- {-# INLINE recip #-}- fromRational = broadcastArray . fromRational- {-# INLINE fromRational #-}----instance Floating (ArrayF ds) where- pi = broadcastArray pi- {-# INLINE pi #-}- exp = mapV expFloat#- {-# INLINE exp #-}- log = mapV logFloat#- {-# INLINE log #-}- sqrt = mapV sqrtFloat#- {-# INLINE sqrt #-}- sin = mapV sinFloat#- {-# INLINE sin #-}- cos = mapV cosFloat#- {-# INLINE cos #-}- tan = mapV tanFloat#- {-# INLINE tan #-}- asin = mapV asinFloat#- {-# INLINE asin #-}- acos = mapV acosFloat#- {-# INLINE acos #-}- atan = mapV atanFloat#- {-# INLINE atan #-}- sinh = mapV sinFloat#- {-# INLINE sinh #-}- cosh = mapV coshFloat#- {-# INLINE cosh #-}- tanh = mapV tanhFloat#- {-# INLINE tanh #-}- (**) = zipV powerFloat#- {-# INLINE (**) #-}-- logBase = zipV (\x y -> logFloat# y `divideFloat#` logFloat# x)- {-# INLINE logBase #-}- asinh = mapV (\x -> logFloat# (x `plusFloat#`- sqrtFloat# (1.0# `plusFloat#` timesFloat# x x)))- {-# INLINE asinh #-}- acosh = mapV (\x -> case plusFloat# x 1.0# of- y -> logFloat# ( x `plusFloat#` timesFloat# y- (sqrtFloat# (minusFloat# x 1.0# `divideFloat#` y))- )- )- {-# INLINE acosh #-}- atanh = mapV (\x -> 0.5# `timesFloat#`- logFloat# (plusFloat# 1.0# x `divideFloat#` minusFloat# 1.0# x))- {-# INLINE atanh #-}-----instance (KnownDim n, KnownDim m, ArrayF '[n,m] ~ Array Float '[n,m], 2 <= n, 2 <= m)- => MatrixCalculus Float n m where- transpose (KnownDataFrame (ArrayF# offs nm arr)) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop2# n m- (\i j s' -> writeFloatArray# marr (j +# m *# i)- (indexFloatArray# arr (offs +# j *# n +# i)) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, nm, r #)- where- n = case dimVal' @n of I# np -> np- m = case dimVal' @m of I# mp -> mp- bs = n *# m *# SIZEOF_HSFLOAT#- transpose (KnownDataFrame (FromScalarF# x)) = unsafeCoerce# $ FromScalarF# x--instance ( KnownDim n, ArrayF '[n,n] ~ Array Float '[n,n] )- => SquareMatrixCalculus Float n where- eye = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop1# n- (\j s' -> writeFloatArray# marr (j *# n1) 1.0# s'- ) (setByteArray# marr 0# bs 0# s1) of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)- where- n1 = n +# 1#- n = case dimVal' @n of I# np -> np- bs = n *# n *# SIZEOF_HSFLOAT#- {-# INLINE eye #-}- diag (KnownDataFrame (Scalar (F# v))) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) -> case loop1# n- (\j s' -> writeFloatArray# marr (j *# n1) v s'- ) (setByteArray# marr 0# bs 0# s1) of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# n, r #)- where- n1 = n +# 1#- n = case dimVal' @n of I# np -> np- bs = n *# n *# SIZEOF_HSFLOAT#- {-# INLINE diag #-}--- det (KnownDataFrame (ArrayF# off nsqr arr)) = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, mat #) -> case newByteArray#- (n *# SIZEOF_HSFLOAT#)- (copyByteArray# arr offb mat 0# bs s1) of- (# s2, vec #) ->- let f i x s | isTrue# (i >=# n) = (# s, x #)- | otherwise =- let !(# s' , j #) = maxInRowRem# n n i mat s- !(# s'', x' #) = if isTrue# (i /=# j)- then (# swapCols# n i j vec mat s'- , negateFloat# x #)- else (# s', x #)- !(# s''', y #) = clearRowEnd# n n i mat s''- in if isTrue# (eqFloat# 0.0# y)- then (# s''', 0.0# #)- else f (i +# 1#) (timesFloat# x' y) s'''- in f 0# 1.0# s2- ) of (# _, r #) -> F# r- where- n = case dimVal' @n of I# np -> np- offb = off *# SIZEOF_HSFLOAT#- bs = nsqr *# SIZEOF_HSFLOAT#- det (KnownDataFrame (FromScalarF# _)) = 0- {-# INLINE det #-}---- trace (KnownDataFrame (ArrayF# off nsqr a)) = KnownDataFrame (Scalar (F# (loop' 0# 0.0#)))- where- n1 = n +# 1#- n = case dimVal' @n of I# np -> np- loop' i acc | isTrue# (i ># nsqr) = acc- | otherwise = loop' (i +# n1)- (indexFloatArray# a (off +# i) `plusFloat#` acc)- trace (KnownDataFrame (FromScalarF# x)) = KnownDataFrame (Scalar (F# (x `timesFloat#` n)))- where- n = case fromIntegral (dimVal' @n) of F# np -> np- {-# INLINE trace #-}----instance (KnownNat n, ArrayF '[n,n] ~ Array Float '[n,n], 2 <= n) => MatrixInverse Float n where- inverse (KnownDataFrame (ArrayF# offs nsqr arr)) = case runRW#- ( \s0 -> case newByteArray# (bs *# 2#) s0 of- (# s1, mat #) -> case newByteArray# (vs *# 2#)- -- copy original matrix to the top of an augmented matrix- (loop1# n (\i s -> writeFloatArray# mat- (i *# nn +# i +# n) 1.0#- (copyByteArray# arr (offb +# i *# vs)- mat (2# *# i *# vs) vs s))- (setByteArray# mat 0# (bs *# 2#) 0# s1)- ) of- (# s2, vec #) ->- let f i s | isTrue# (i >=# n) = s- | otherwise =- let !(# s' , j #) = maxInRowRem# nn n i mat s- s'' = if isTrue# (i /=# j) then swapCols# nn i j vec mat s'- else s'- !(# s''', _ #) = clearRowAll# nn n i mat s''- in f (i +# 1#) s'''- in unsafeFreezeByteArray# mat- ( shrinkMutableByteArray# mat bs- (-- copy inverse matrix from the augmented part- loop1# n (\i s ->- copyMutableByteArray# mat- (2# *# i *# vs +# vs)- mat (i *# vs) vs s)- (f 0# s2)- )- )- ) of (# _, r #) -> KnownDataFrame (ArrayF# 0# nsqr r)- where- nn = 2# *# n- n = case dimVal' @n of I# np -> np- vs = n *# SIZEOF_HSFLOAT#- bs = n *# n *# SIZEOF_HSFLOAT#- offb = offs *# SIZEOF_HSFLOAT#- inverse (KnownDataFrame (FromScalarF# _)) = error "Cannot take inverse of a degenerate matrix"----------------------------------------------------------------------------------- Helpers---------------------------------------------------------------------------------- #ifndef UNSAFE_INDICES--- | isTrue# ( (i ># dim# _x)--- `orI#` (i <=# 0#)--- ) = error $ "Bad index " ++--- show (I# i) ++ " for " ++ show (dim _x) ++ "D vector"--- | otherwise--- #endif----- | Swap columns i and j. Does not check if i or j is larger than matrix width m-swapCols# :: Int# -- n- -> Int# -- ith column to swap- -> Int# -- jth column to swap- -> MutableByteArray# s -- buffer byte array of length of n elems- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> State# s -- next state-swapCols# n i j vec mat s0 =- -- copy ith column to bugger vec- case copyMutableByteArray# mat (i *# bs) vec 0# bs s0 of- s1 -> case copyMutableByteArray# mat (j *# bs) mat (i *# bs) bs s1 of- s2 -> copyMutableByteArray# vec 0# mat (j *# bs) bs s2- where- bs = n *# SIZEOF_HSFLOAT#---- | Starting from i-th row and i+1-th column, substract a multiple of i-th column from i+1 .. m columns,--- such that there are only zeroes in i-th row and i+1..m columns elements.-clearRowEnd# :: Int# -- n- -> Int# -- m- -> Int# -- ith column to remove from all others- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> (# State# s, Float# #) -- next state and a diagonal element-clearRowEnd# n m i mat s0 = (# loop' (i +# 1#) s1, y' #)- where- y0 = (n +# 1#) *# i +# 1# -- first element in source column- !(# s1, y' #) = readFloatArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero- yrc = 1.0# `divideFloat#` y'- n' = n -# i -# 1#- loop' k s | isTrue# (k >=# m) = s- | otherwise = loop' (k +# 1#)- ( let x0 = k *# n +# i- !(# s', a' #) = readFloatArray# mat x0 s- s'' = writeFloatArray# mat x0 0.0# s'- a = a' `timesFloat#` yrc- in multNRem# n' (x0 +# 1#) y0 a mat s''- )---- | Substract a multiple of i-th column from 0 .. i-1 and i+1 .. m columns,--- such that there are only zeroes in i-th row everywhere except i-th column--- Assuming that elements in 0..i-1 columnts and in i-th row are zeroes, so they do not affect other columns.--- After all columns updated, divide i-th row by its diagonal element, so (i,i) element has 1.-clearRowAll# :: Int# -- n- -> Int# -- m- -> Int# -- ith column to remove from all others- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> (# State# s, Float# #) -- next state and a diagonal element-clearRowAll# n m i mat s0 = (# divLoop (i +# 1#)- (writeFloatArray# mat ((n +# 1#) *# i) 1.0#- (loop' 0# i (loop' (i +# 1#) m s1))), y' #)- where- y0 = (n +# 1#) *# i +# 1# -- first element in source column- !(# s1, y' #) = readFloatArray# mat ((n +# 1#) *# i) s0 -- diagonal element, must be non-zero- yrc = 1.0# `divideFloat#` y'- n' = n -# i -# 1#- loop' k km s | isTrue# (k >=# km) = s- | otherwise = loop' (k +# 1#) km- ( let x0 = k *# n +# i- !(# s', a' #) = readFloatArray# mat x0 s- s'' = writeFloatArray# mat x0 0.0# s'- a = a' `timesFloat#` yrc- in multNRem# n' (x0 +# 1#) y0 a mat s''- )- divLoop k s | isTrue# (k >=# n) = s- | otherwise = divLoop (k +# 1#)- ( let x0 = n *# i +# k- !(# s', x #) = readFloatArray# mat x0 s- in writeFloatArray# mat x0 (timesFloat# x yrc) s'- )----- | Remove a multiple of one row from another one.--- do: xi = xi - yi*a-multNRem# :: Int# -- n - nr of elements to go through- -> Int# -- start idx of x (update)- -> Int# -- start idx of y (read)- -> Float# -- multiplier a- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> State# s -- next state-multNRem# 0# _ _ _ _ s = s-multNRem# n x0 y0 a mat s = multNRem# (n -# 1#) (x0 +# 1#) (y0 +# 1#) a mat- ( case readFloatArray# mat y0 s of- (# s1, y #) -> case readFloatArray# mat x0 s1 of- (# s2, x #) -> writeFloatArray# mat x0 (x `minusFloat#` timesFloat# y a) s2- )------ | Gives index of maximum (absolute) element in i-th row, starting from i-th element only.--- If i >= m then returns i.-maxInRowRem# :: Int# -- n- -> Int# -- m- -> Int# -- ith column to start to search for and a row to look in- -> MutableByteArray# s -- byte array of matrix- -> State# s -- previous state- -> (# State# s, Int# #) -- next state-maxInRowRem# n m i mat s0 = loop' i (abs# v) i s1- where- !(# s1, v #) = readFloatArray# mat ((n +# 1#) *# i) s0- abs# x = if isTrue# (x `geFloat#` 0.0#) then x else negateFloat# x- loop' ok ov k s | isTrue# (k >=# m) = (# s, ok #)- | otherwise = case readFloatArray# mat (n *# k +# i) s of- (# s', v' #) -> if isTrue# (abs# v' `gtFloat#` ov)- then loop' k (abs# v') (k +# 1#) s'- else loop' ok ov (k +# 1#) s'---- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1-loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s)- -> State# s -> State# s-loop2# n m f = loop0 0# 0#- where- loop0 i j s | isTrue# (j ==# m) = s- | isTrue# (i ==# n) = loop0 0# (j +# 1#) s- | otherwise = case f i j s of s1 -> loop0 (i +# 1#) j s1-{-# INLINE loop2# #-}
− src/Numeric/Array/Family/ArrayI.hs
@@ -1,95 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayI--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayI () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayI-#define ARR_FROMSCALAR FromScalarI#-#define ARR_CONSTR ArrayI#-#define EL_TYPE_BOXED Int-#define EL_TYPE_PRIM Int#-#define EL_RUNTIME_REP 'IntRep-#define EL_CONSTR I#-#define EL_SIZE SIZEOF_HSINT#-#define EL_ALIGNMENT ALIGNMENT_HSINT#-#define EL_ZERO 0#-#define EL_ONE 1#-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexIntArray#-#define WRITE_ARRAY writeIntArray#-#define OP_EQ (==#)-#define OP_NE (/=#)-#define OP_GT (>#)-#define OP_GE (>=#)-#define OP_LT (<#)-#define OP_LE (<=#)-#define OP_PLUS (+#)-#define OP_MINUS (-#)-#define OP_TIMES (*#)-#define OP_NEGATE negateInt#-#include "Array.h"---instance Num (ArrayI ds) where- (+) = zipV (+#)- {-# INLINE (+) #-}- (-) = zipV (-#)- {-# INLINE (-) #-}- (*) = zipV (*#)- {-# INLINE (*) #-}- negate = mapV negateInt#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (x >=# 0#)- then x- else negateInt# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (x ># 0#)- then 1#- else if isTrue# (x <# 0#)- then -1#- else 0#- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Bounded (ArrayI ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayI16.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayI16--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayI16 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Int (Int16 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayI16-#define ARR_FROMSCALAR FromScalarI16#-#define ARR_CONSTR ArrayI16#-#define EL_TYPE_BOXED Int16-#define EL_TYPE_PRIM Int#-#define EL_RUNTIME_REP 'IntRep-#define EL_CONSTR I16#-#define EL_SIZE SIZEOF_INT16#-#define EL_ALIGNMENT ALIGNMENT_INT16#-#define EL_ZERO 0#-#define EL_ONE 1#-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexInt16Array#-#define WRITE_ARRAY writeInt16Array#-#define OP_EQ (==#)-#define OP_NE (/=#)-#define OP_GT (>#)-#define OP_GE (>=#)-#define OP_LT (<#)-#define OP_LE (<=#)-#define OP_PLUS (+#)-#define OP_MINUS (-#)-#define OP_TIMES (*#)-#define OP_NEGATE negateInt#-#include "Array.h"---instance Num (ArrayI16 ds) where- (+) = zipV (+#)- {-# INLINE (+) #-}- (-) = zipV (-#)- {-# INLINE (-) #-}- (*) = zipV (*#)- {-# INLINE (*) #-}- negate = mapV negateInt#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (x >=# 0#)- then x- else negateInt# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (x ># 0#)- then 1#- else if isTrue# (x <# 0#)- then -1#- else 0#- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Bounded (ArrayI16 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayI32.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayI32--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayI32 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Int (Int32 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayI32-#define ARR_FROMSCALAR FromScalarI32#-#define ARR_CONSTR ArrayI32#-#define EL_TYPE_BOXED Int32-#define EL_TYPE_PRIM Int#-#define EL_RUNTIME_REP 'IntRep-#define EL_CONSTR I32#-#define EL_SIZE SIZEOF_INT32#-#define EL_ALIGNMENT ALIGNMENT_INT32#-#define EL_ZERO 0#-#define EL_ONE 1#-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexInt32Array#-#define WRITE_ARRAY writeInt32Array#-#define OP_EQ (==#)-#define OP_NE (/=#)-#define OP_GT (>#)-#define OP_GE (>=#)-#define OP_LT (<#)-#define OP_LE (<=#)-#define OP_PLUS (+#)-#define OP_MINUS (-#)-#define OP_TIMES (*#)-#define OP_NEGATE negateInt#-#include "Array.h"---instance Num (ArrayI32 ds) where- (+) = zipV (+#)- {-# INLINE (+) #-}- (-) = zipV (-#)- {-# INLINE (-) #-}- (*) = zipV (*#)- {-# INLINE (*) #-}- negate = mapV negateInt#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (x >=# 0#)- then x- else negateInt# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (x ># 0#)- then 1#- else if isTrue# (x <# 0#)- then -1#- else 0#- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Bounded (ArrayI32 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayI64.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayI64--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayI64 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Int (Int64 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayI64-#define ARR_FROMSCALAR FromScalarI64#-#define ARR_CONSTR ArrayI64#-#define EL_TYPE_BOXED Int64-#define EL_TYPE_PRIM Int#-#define EL_RUNTIME_REP 'IntRep-#define EL_CONSTR I64#-#define EL_SIZE SIZEOF_INT64#-#define EL_ALIGNMENT ALIGNMENT_INT64#-#define EL_ZERO 0#-#define EL_ONE 1#-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexInt64Array#-#define WRITE_ARRAY writeInt64Array#-#define OP_EQ (==#)-#define OP_NE (/=#)-#define OP_GT (>#)-#define OP_GE (>=#)-#define OP_LT (<#)-#define OP_LE (<=#)-#define OP_PLUS (+#)-#define OP_MINUS (-#)-#define OP_TIMES (*#)-#define OP_NEGATE negateInt#-#include "Array.h"---instance Num (ArrayI64 ds) where- (+) = zipV (+#)- {-# INLINE (+) #-}- (-) = zipV (-#)- {-# INLINE (-) #-}- (*) = zipV (*#)- {-# INLINE (*) #-}- negate = mapV negateInt#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (x >=# 0#)- then x- else negateInt# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (x ># 0#)- then 1#- else if isTrue# (x <# 0#)- then -1#- else 0#- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Bounded (ArrayI64 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayI8.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayI8--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayI8 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Int (Int8 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayI8-#define ARR_FROMSCALAR FromScalarI8#-#define ARR_CONSTR ArrayI8#-#define EL_TYPE_BOXED Int8-#define EL_TYPE_PRIM Int#-#define EL_RUNTIME_REP 'IntRep-#define EL_CONSTR I8#-#define EL_SIZE SIZEOF_INT8#-#define EL_ALIGNMENT ALIGNMENT_INT8#-#define EL_ZERO 0#-#define EL_ONE 1#-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexInt8Array#-#define WRITE_ARRAY writeInt8Array#-#define OP_EQ (==#)-#define OP_NE (/=#)-#define OP_GT (>#)-#define OP_GE (>=#)-#define OP_LT (<#)-#define OP_LE (<=#)-#define OP_PLUS (+#)-#define OP_MINUS (-#)-#define OP_TIMES (*#)-#define OP_NEGATE negateInt#-#include "Array.h"---instance Num (ArrayI8 ds) where- (+) = zipV (+#)- {-# INLINE (+) #-}- (-) = zipV (-#)- {-# INLINE (-) #-}- (*) = zipV (*#)- {-# INLINE (*) #-}- negate = mapV negateInt#- {-# INLINE negate #-}- abs = mapV (\x -> if isTrue# (x >=# 0#)- then x- else negateInt# x- )- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (x ># 0#)- then 1#- else if isTrue# (x <# 0#)- then -1#- else 0#- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}--instance Bounded (ArrayI8 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayW.hs
@@ -1,89 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayW--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayW () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Word (..), Int (..), RuntimeRep (..), isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayW-#define ARR_FROMSCALAR FromScalarW#-#define ARR_CONSTR ArrayW#-#define EL_TYPE_BOXED Word-#define EL_TYPE_PRIM Word#-#define EL_RUNTIME_REP 'WordRep-#define EL_CONSTR W#-#define EL_SIZE SIZEOF_HSWORD#-#define EL_ALIGNMENT ALIGNMENT_HSWORD#-#define EL_ZERO 0##-#define EL_ONE 1##-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexWordArray#-#define WRITE_ARRAY writeWordArray#-#define OP_EQ eqWord#-#define OP_NE neWord#-#define OP_GT gtWord#-#define OP_GE geWord#-#define OP_LT ltWord#-#define OP_LE leWord#-#define OP_PLUS plusWord#-#define OP_MINUS minusWord#-#define OP_TIMES timesWord#-#include "Array.h"--instance Num (ArrayW ds) where- (+) = zipV plusWord#- {-# INLINE (+) #-}- (-) = zipV minusWord#- {-# INLINE (-) #-}- (*) = zipV timesWord#- {-# INLINE (*) #-}- negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))- {-# INLINE negate #-}- abs = id- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (gtWord# x 0##)- then 1##- else 0##- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}---instance Bounded (ArrayW ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayW16.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayW16--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayW16 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Word (Word16 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayW16-#define ARR_FROMSCALAR FromScalarW16#-#define ARR_CONSTR ArrayW16#-#define EL_TYPE_BOXED Word16-#define EL_TYPE_PRIM Word#-#define EL_RUNTIME_REP 'WordRep-#define EL_CONSTR W16#-#define EL_SIZE SIZEOF_WORD16#-#define EL_ALIGNMENT ALIGNMENT_WORD16#-#define EL_ZERO 0##-#define EL_ONE 1##-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexWord16Array#-#define WRITE_ARRAY writeWord16Array#-#define OP_EQ eqWord#-#define OP_NE neWord#-#define OP_GT gtWord#-#define OP_GE geWord#-#define OP_LT ltWord#-#define OP_LE leWord#-#define OP_PLUS plusWord#-#define OP_MINUS minusWord#-#define OP_TIMES timesWord#-#include "Array.h"--instance Num (ArrayW16 ds) where- (+) = zipV plusWord#- {-# INLINE (+) #-}- (-) = zipV minusWord#- {-# INLINE (-) #-}- (*) = zipV timesWord#- {-# INLINE (*) #-}- negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))- {-# INLINE negate #-}- abs = id- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (gtWord# x 0##)- then 1##- else 0##- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}---instance Bounded (ArrayW16 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayW32.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayW32--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayW32 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Word (Word32 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayW32-#define ARR_FROMSCALAR FromScalarW32#-#define ARR_CONSTR ArrayW32#-#define EL_TYPE_BOXED Word32-#define EL_TYPE_PRIM Word#-#define EL_RUNTIME_REP 'WordRep-#define EL_CONSTR W32#-#define EL_SIZE SIZEOF_WORD32#-#define EL_ALIGNMENT ALIGNMENT_WORD32#-#define EL_ZERO 0##-#define EL_ONE 1##-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexWord32Array#-#define WRITE_ARRAY writeWord32Array#-#define OP_EQ eqWord#-#define OP_NE neWord#-#define OP_GT gtWord#-#define OP_GE geWord#-#define OP_LT ltWord#-#define OP_LE leWord#-#define OP_PLUS plusWord#-#define OP_MINUS minusWord#-#define OP_TIMES timesWord#-#include "Array.h"--instance Num (ArrayW32 ds) where- (+) = zipV plusWord#- {-# INLINE (+) #-}- (-) = zipV minusWord#- {-# INLINE (-) #-}- (*) = zipV timesWord#- {-# INLINE (*) #-}- negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))- {-# INLINE negate #-}- abs = id- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (gtWord# x 0##)- then 1##- else 0##- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}---instance Bounded (ArrayW32 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayW64.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayW64--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayW64 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Word (Word64 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayW64-#define ARR_FROMSCALAR FromScalarW64#-#define ARR_CONSTR ArrayW64#-#define EL_TYPE_BOXED Word64-#define EL_TYPE_PRIM Word#-#define EL_RUNTIME_REP 'WordRep-#define EL_CONSTR W64#-#define EL_SIZE SIZEOF_WORD64#-#define EL_ALIGNMENT ALIGNMENT_WORD64#-#define EL_ZERO 0##-#define EL_ONE 1##-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexWord64Array#-#define WRITE_ARRAY writeWord64Array#-#define OP_EQ eqWord#-#define OP_NE neWord#-#define OP_GT gtWord#-#define OP_GE geWord#-#define OP_LT ltWord#-#define OP_LE leWord#-#define OP_PLUS plusWord#-#define OP_MINUS minusWord#-#define OP_TIMES timesWord#-#include "Array.h"--instance Num (ArrayW64 ds) where- (+) = zipV plusWord#- {-# INLINE (+) #-}- (-) = zipV minusWord#- {-# INLINE (-) #-}- (*) = zipV timesWord#- {-# INLINE (*) #-}- negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))- {-# INLINE negate #-}- abs = id- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (gtWord# x 0##)- then 1##- else 0##- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}---instance Bounded (ArrayW64 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/ArrayW8.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.ArrayW8--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.ArrayW8 () where--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), isTrue#)-import GHC.Word (Word8 (..))--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Dimensions.Traverse---#include "MachDeps.h"-#define ARR_TYPE ArrayW8-#define ARR_FROMSCALAR FromScalarW8#-#define ARR_CONSTR ArrayW8#-#define EL_TYPE_BOXED Word8-#define EL_TYPE_PRIM Word#-#define EL_RUNTIME_REP 'WordRep-#define EL_CONSTR W8#-#define EL_SIZE SIZEOF_WORD8#-#define EL_ALIGNMENT ALIGNMENT_WORD8#-#define EL_ZERO 0##-#define EL_ONE 1##-#define EL_MINUS_ONE -1#-#define INDEX_ARRAY indexWord8Array#-#define WRITE_ARRAY writeWord8Array#-#define OP_EQ eqWord#-#define OP_NE neWord#-#define OP_GT gtWord#-#define OP_GE geWord#-#define OP_LT ltWord#-#define OP_LE leWord#-#define OP_PLUS plusWord#-#define OP_MINUS minusWord#-#define OP_TIMES timesWord#-#include "Array.h"--instance Num (ArrayW8 ds) where- (+) = zipV plusWord#- {-# INLINE (+) #-}- (-) = zipV minusWord#- {-# INLINE (-) #-}- (*) = zipV timesWord#- {-# INLINE (*) #-}- negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))- {-# INLINE negate #-}- abs = id- {-# INLINE abs #-}- signum = mapV (\x -> if isTrue# (gtWord# x 0##)- then 1##- else 0##- )- {-# INLINE signum #-}- fromInteger = broadcastArray . fromInteger- {-# INLINE fromInteger #-}---instance Bounded (ArrayW8 ds) where- minBound = broadcastArray minBound- maxBound = broadcastArray maxBound
− src/Numeric/Array/Family/FloatX2.hs
@@ -1,321 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.FloatX2--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.FloatX2 () where---#include "MachDeps.h"--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Float (..), RuntimeRep (..),- isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions------instance Show FloatX2 where- show (FloatX2# a1 a2) = "{ " ++ show (F# a1)- ++ ", " ++ show (F# a2)- ++ " }"----instance Eq FloatX2 where- FloatX2# a1 a2 == FloatX2# b1 b2 = isTrue# ( (a1 `eqFloat#` b1)- `andI#` (a2 `eqFloat#` b2)- )- {-# INLINE (==) #-}- FloatX2# a1 a2 /= FloatX2# b1 b2 = isTrue# ( (a1 `neFloat#` b1)- `orI#` (a2 `neFloat#` b2)- )- {-# INLINE (/=) #-}------ | Implement partial ordering for `>`, `<`, `>=`, `<=`--- and lexicographical ordering for `compare`-instance Ord FloatX2 where- FloatX2# a1 a2 > FloatX2# b1 b2 = isTrue# ( (a1 `gtFloat#` b1)- `andI#` (a2 `gtFloat#` b2)- )- {-# INLINE (>) #-}- FloatX2# a1 a2 < FloatX2# b1 b2 = isTrue# ( (a1 `ltFloat#` b1)- `andI#` (a2 `ltFloat#` b2)- )- {-# INLINE (<) #-}- FloatX2# a1 a2 >= FloatX2# b1 b2 = isTrue# ( (a1 `geFloat#` b1)- `andI#` (a2 `geFloat#` b2)- )- {-# INLINE (>=) #-}- FloatX2# a1 a2 <= FloatX2# b1 b2 = isTrue# ( (a1 `leFloat#` b1)- `andI#` (a2 `leFloat#` b2)- )- {-# INLINE (<=) #-}- -- | Compare lexicographically- compare (FloatX2# a1 a2) (FloatX2# b1 b2)- | isTrue# (a1 `gtFloat#` b1) = GT- | isTrue# (a1 `ltFloat#` b1) = LT- | isTrue# (a2 `gtFloat#` b2) = GT- | isTrue# (a2 `ltFloat#` b2) = LT- | otherwise = EQ- {-# INLINE compare #-}- -- | Element-wise minimum- min (FloatX2# a1 a2) (FloatX2# b1 b2) =- FloatX2# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)- (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)- {-# INLINE min #-}- -- | Element-wise maximum- max (FloatX2# a1 a2) (FloatX2# b1 b2) =- FloatX2# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)- (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)- {-# INLINE max #-}------ | element-wise operations for vectors-instance Num FloatX2 where- FloatX2# a1 a2 + FloatX2# b1 b2- = FloatX2# (plusFloat# a1 b1) (plusFloat# a2 b2)- {-# INLINE (+) #-}- FloatX2# a1 a2 - FloatX2# b1 b2- = FloatX2# (minusFloat# a1 b1) (minusFloat# a2 b2)- {-# INLINE (-) #-}- FloatX2# a1 a2 * FloatX2# b1 b2- = FloatX2# (timesFloat# a1 b1) (timesFloat# a2 b2)- {-# INLINE (*) #-}- negate (FloatX2# a1 a2)- = FloatX2# (negateFloat# a1) (negateFloat# a2)- {-# INLINE negate #-}- abs (FloatX2# a1 a2)- = FloatX2# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)- (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)- {-# INLINE abs #-}- signum (FloatX2# a1 a2)- = FloatX2# (if isTrue# (a1 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )- (if isTrue# (a2 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )- {-# INLINE signum #-}- fromInteger n = case fromInteger n of F# x -> FloatX2# x x- {-# INLINE fromInteger #-}----instance Fractional FloatX2 where- FloatX2# a1 a2 / FloatX2# b1 b2 = FloatX2# (divideFloat# a1 b1)- (divideFloat# a2 b2)- {-# INLINE (/) #-}- recip (FloatX2# a1 a2) = FloatX2# (divideFloat# 1.0# a1)- (divideFloat# 1.0# a2)- {-# INLINE recip #-}- fromRational r = case fromRational r of F# x -> FloatX2# x x- {-# INLINE fromRational #-}----instance Floating FloatX2 where- pi = FloatX2# 3.141592653589793238# 3.141592653589793238#- {-# INLINE pi #-}- exp (FloatX2# a1 a2) = FloatX2# (expFloat# a1)- (expFloat# a2)- {-# INLINE exp #-}- log (FloatX2# a1 a2) = FloatX2# (logFloat# a1)- (logFloat# a2)- {-# INLINE log #-}- sqrt (FloatX2# a1 a2) = FloatX2# (sqrtFloat# a1)- (sqrtFloat# a2)- {-# INLINE sqrt #-}- sin (FloatX2# a1 a2) = FloatX2# (sinFloat# a1)- (sinFloat# a2)- {-# INLINE sin #-}- cos (FloatX2# a1 a2) = FloatX2# (cosFloat# a1)- (cosFloat# a2)- {-# INLINE cos #-}- tan (FloatX2# a1 a2) = FloatX2# (tanFloat# a1)- (tanFloat# a2)- {-# INLINE tan #-}- asin (FloatX2# a1 a2) = FloatX2# (asinFloat# a1)- (asinFloat# a2)- {-# INLINE asin #-}- acos (FloatX2# a1 a2) = FloatX2# (acosFloat# a1)- (acosFloat# a2)- {-# INLINE acos #-}- atan (FloatX2# a1 a2) = FloatX2# (atanFloat# a1)- (atanFloat# a2)- {-# INLINE atan #-}- sinh (FloatX2# a1 a2) = FloatX2# (sinFloat# a1)- (sinFloat# a2)- {-# INLINE sinh #-}- cosh (FloatX2# a1 a2) = FloatX2# (coshFloat# a1)- (coshFloat# a2)- {-# INLINE cosh #-}- tanh (FloatX2# a1 a2) = FloatX2# (tanhFloat# a1)- (tanhFloat# a2)- {-# INLINE tanh #-}- FloatX2# a1 a2 ** FloatX2# b1 b2 = FloatX2# (powerFloat# a1 b1)- (powerFloat# a2 b2)- {-# INLINE (**) #-}-- logBase x y = log y / log x- {-# INLINE logBase #-}- asinh x = log (x + sqrt (1.0+x*x))- {-# INLINE asinh #-}- acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))- {-# INLINE acosh #-}- atanh x = 0.5 * log ((1.0+x) / (1.0-x))- {-# INLINE atanh #-}------ log1p (FloatX2# a1 a2) = case ( log1p (F# a1), log1p (F# a2) ) of--- (F# x1, F# x2) -> FloatX2# x1 x2--- expm1 (FloatX2# a1 a2) = case ( expm1 (F# a1), expm1 (F# a2) ) of--- (F# x1, F# x2) -> FloatX2# x1 x2------ log1mexp a--- | a <= log 2 = log (negate (expm1Float a))--- | otherwise = log1p (negate (exp a))--- {-# INLINE log1mexp #-}--- log1pexp a--- | a <= 18 = log1p (exp a)--- | a <= 100 = a + exp (negate a)--- | otherwise = a--- {-# INLINE log1pexp #-}------ instance VectorCalculus Float 2 FloatX2 where--- broadcastVec (F# x) = FloatX2# x x--- {-# INLINE broadcastVec #-}--- FloatX2# a1 a2 .*. FloatX2# b1 b2 = case timesFloat# a1 b1--- `plusFloat#` timesFloat# a2 b2 of--- x -> FloatX2# x x--- {-# INLINE (.*.) #-}--- FloatX2# a1 a2 `dot` FloatX2# b1 b2 = F# ( timesFloat# a1 b1--- `plusFloat#` timesFloat# a2 b2--- )--- {-# INLINE dot #-}--- indexVec 1 (FloatX2# a1 _) = F# a1--- indexVec 2 (FloatX2# _ a2) = F# a2--- indexVec i _ = error $ "Bad index " ++ show i ++ " for 2D vector"--- {-# INLINE indexVec #-}--- normL1 v = case abs v of--- FloatX2# a1 a2 -> F# (a1 `plusFloat#` a2)--- {-# INLINE normL1 #-}--- normL2 v = sqrt $ dot v v--- {-# INLINE normL2 #-}--- normLPInf (FloatX2# a1 a2)--- = F# (if isTrue# (a1 `gtFloat#` a2) then a1 else a2)--- {-# INLINE normLPInf #-}--- normLNInf (FloatX2# a1 a2)--- = F# (if isTrue# (a1 `gtFloat#` a2) then a2 else a1)--- {-# INLINE normLNInf #-}--- normLP n (FloatX2# a1 a2) = case realToFrac n of--- F# x -> F# ( powerFloat# (divideFloat# 1.0# x)--- ( powerFloat# a1 x--- `plusFloat#` powerFloat# a2 x--- )--- )--- {-# INLINE normLP #-}--- dim _ = 2--- {-# INLINE dim #-}--------------- instance Vector2D Float where--- vec2 (F# x) (F# y) = FloatX2# x y--- {-# INLINE vec2 #-}--- det2 (FloatX2# a1 a2) (FloatX2# b1 b2)--- = F# (timesFloat# a1 b2 `minusFloat#` timesFloat# a2 b1)--- {-# INLINE det2 #-}--type instance ElemRep FloatX2 = 'FloatRep-type instance ElemPrim FloatX2 = Float#-instance PrimBytes FloatX2 where- toBytes (FloatX2# a1 a2) = case runRW#- ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 2#) s0 of- (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of- s2 -> case writeFloatArray# marr 1# a2 s2 of- s3 -> unsafeFreezeByteArray# marr s3- ) of (# _, a #) -> (# 0#, 2#, a #)- {-# INLINE toBytes #-}- fromBytes (# off, _, arr #) = FloatX2#- (indexFloatArray# arr off)- (indexFloatArray# arr (off +# 1#))- {-# INLINE fromBytes #-}- byteSize _ = SIZEOF_HSFLOAT# *# 2#- {-# INLINE byteSize #-}- byteAlign _ = ALIGNMENT_HSFLOAT#- {-# INLINE byteAlign #-}- elementByteSize _ = SIZEOF_HSFLOAT#- {-# INLINE elementByteSize #-}- ix 0# (FloatX2# a1 _) = a1- ix 1# (FloatX2# _ a2) = a2- ix _ _ = undefined- {-# INLINE ix #-}---instance ElementWise (Idx '[2]) Float FloatX2 where-- (!) (FloatX2# a1 _) ( 1 :! Z) = F# a1- (!) (FloatX2# _ a2) ( 2 :! Z) = F# a2- (!) _ ( _ :! Z) = undefined- {-# INLINE (!) #-}-- broadcast (F# x) = FloatX2# x x- {-# INLINE broadcast #-}-- ewmap f (FloatX2# x y) = case (f (1:!Z) (F# x), f (2:!Z) (F# y)) of- (F# r1, F# r2) -> FloatX2# r1 r2- {-# INLINE ewmap #-}-- ewgen f = case (f (1:!Z), f (2:!Z)) of (F# r1, F# r2) -> FloatX2# r1 r2- {-# INLINE ewgen #-}-- ewgenA f = (\(F# r1) (F# r2) -> FloatX2# r1 r2) <$> f (1:!Z) <*> f (2:!Z)- {-# INLINE ewgenA #-}-- ewfoldl f x0 (FloatX2# x y) = f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)- {-# INLINE ewfoldl #-}-- ewfoldr f x0 (FloatX2# x y) = f (1:!Z) (F# x) (f (2:!Z) (F# y) x0)- {-# INLINE ewfoldr #-}-- elementWise f (FloatX2# x y) = (\(F# a) (F# b) -> FloatX2# a b)- <$> f (F# x) <*> f (F# y)- {-# INLINE elementWise #-}-- indexWise f (FloatX2# x y) = (\(F# a) (F# b) -> FloatX2# a b)- <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y)- {-# INLINE indexWise #-}-- update (1 :! Z) (F# q) (FloatX2# _ y) = FloatX2# q y- update (2 :! Z) (F# q) (FloatX2# x _) = FloatX2# x q- update (_ :! Z) _ x = x- {-# INLINE update #-}
− src/Numeric/Array/Family/FloatX3.hs
@@ -1,294 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.FloatX3--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.FloatX3 () where---#include "MachDeps.h"--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Float (..), RuntimeRep (..),- isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions------instance Show FloatX3 where- show (FloatX3# a1 a2 a3) = "{ " ++ show (F# a1)- ++ ", " ++ show (F# a2)- ++ ", " ++ show (F# a3)- ++ " }"----instance Eq FloatX3 where- FloatX3# a1 a2 a3 == FloatX3# b1 b2 b3 = isTrue# ( (a1 `eqFloat#` b1)- `andI#` (a2 `eqFloat#` b2)- `andI#` (a3 `eqFloat#` b3)- )- {-# INLINE (==) #-}- FloatX3# a1 a2 a3 /= FloatX3# b1 b2 b3 = isTrue# ( (a1 `neFloat#` b1)- `orI#` (a2 `neFloat#` b2)- `orI#` (a3 `neFloat#` b3)- )- {-# INLINE (/=) #-}------ | Implement partial ordering for `>`, `<`, `>=`, `<=`--- and lexicographical ordering for `compare`-instance Ord FloatX3 where- FloatX3# a1 a2 a3 > FloatX3# b1 b2 b3 = isTrue# ( (a1 `gtFloat#` b1)- `andI#` (a2 `gtFloat#` b2)- `andI#` (a3 `gtFloat#` b3)- )- {-# INLINE (>) #-}- FloatX3# a1 a2 a3 < FloatX3# b1 b2 b3 = isTrue# ( (a1 `ltFloat#` b1)- `andI#` (a2 `ltFloat#` b2)- `andI#` (a3 `ltFloat#` b3)- )- {-# INLINE (<) #-}- FloatX3# a1 a2 a3 >= FloatX3# b1 b2 b3 = isTrue# ( (a1 `geFloat#` b1)- `andI#` (a2 `geFloat#` b2)- `andI#` (a3 `geFloat#` b3)- )- {-# INLINE (>=) #-}- FloatX3# a1 a2 a3 <= FloatX3# b1 b2 b3 = isTrue# ( (a1 `leFloat#` b1)- `andI#` (a2 `leFloat#` b2)- `andI#` (a3 `leFloat#` b3)- )- {-# INLINE (<=) #-}- -- | Compare lexicographically- compare (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3)- | isTrue# (a1 `gtFloat#` b1) = GT- | isTrue# (a1 `ltFloat#` b1) = LT- | isTrue# (a2 `gtFloat#` b2) = GT- | isTrue# (a2 `ltFloat#` b2) = LT- | isTrue# (a3 `gtFloat#` b3) = GT- | isTrue# (a3 `ltFloat#` b3) = LT- | otherwise = EQ- {-# INLINE compare #-}- -- | Element-wise minimum- min (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3) =- FloatX3# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)- (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)- (if isTrue# (a3 `gtFloat#` b3) then b3 else a3)- {-# INLINE min #-}- -- | Element-wise maximum- max (FloatX3# a1 a2 a3) (FloatX3# b1 b2 b3) =- FloatX3# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)- (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)- (if isTrue# (a3 `gtFloat#` b3) then a3 else b3)- {-# INLINE max #-}------ | element-wise operations for vectors-instance Num FloatX3 where- FloatX3# a1 a2 a3 + FloatX3# b1 b2 b3- = FloatX3# (plusFloat# a1 b1) (plusFloat# a2 b2) (plusFloat# a3 b3)- {-# INLINE (+) #-}- FloatX3# a1 a2 a3 - FloatX3# b1 b2 b3- = FloatX3# (minusFloat# a1 b1) (minusFloat# a2 b2) (minusFloat# a3 b3)- {-# INLINE (-) #-}- FloatX3# a1 a2 a3 * FloatX3# b1 b2 b3- = FloatX3# (timesFloat# a1 b1) (timesFloat# a2 b2) (timesFloat# a3 b3)- {-# INLINE (*) #-}- negate (FloatX3# a1 a2 a3)- = FloatX3# (negateFloat# a1) (negateFloat# a2) (negateFloat# a3)- {-# INLINE negate #-}- abs (FloatX3# a1 a2 a3)- = FloatX3# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)- (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)- (if isTrue# (a3 `geFloat#` 0.0#) then a3 else negateFloat# a3)- {-# INLINE abs #-}- signum (FloatX3# a1 a2 a3)- = FloatX3# (if isTrue# (a1 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )- (if isTrue# (a2 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )- (if isTrue# (a3 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a3 `ltFloat#` 0.0#) then -1.0# else 0.0# )- {-# INLINE signum #-}- fromInteger n = case fromInteger n of F# x -> FloatX3# x x x- {-# INLINE fromInteger #-}----instance Fractional FloatX3 where- FloatX3# a1 a2 a3 / FloatX3# b1 b2 b3 = FloatX3# (divideFloat# a1 b1)- (divideFloat# a2 b2)- (divideFloat# a3 b3)- {-# INLINE (/) #-}- recip (FloatX3# a1 a2 a3) = FloatX3# (divideFloat# 1.0# a1)- (divideFloat# 1.0# a2)- (divideFloat# 1.0# a3)- {-# INLINE recip #-}- fromRational r = case fromRational r of F# x -> FloatX3# x x x- {-# INLINE fromRational #-}----instance Floating FloatX3 where- pi = FloatX3# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238#- {-# INLINE pi #-}- exp (FloatX3# a1 a2 a3) = FloatX3# (expFloat# a1)- (expFloat# a2)- (expFloat# a3)- {-# INLINE exp #-}- log (FloatX3# a1 a2 a3) = FloatX3# (logFloat# a1)- (logFloat# a2)- (logFloat# a3)- {-# INLINE log #-}- sqrt (FloatX3# a1 a2 a3) = FloatX3# (sqrtFloat# a1)- (sqrtFloat# a2)- (sqrtFloat# a3)- {-# INLINE sqrt #-}- sin (FloatX3# a1 a2 a3) = FloatX3# (sinFloat# a1)- (sinFloat# a2)- (sinFloat# a3)- {-# INLINE sin #-}- cos (FloatX3# a1 a2 a3) = FloatX3# (cosFloat# a1)- (cosFloat# a2)- (cosFloat# a3)- {-# INLINE cos #-}- tan (FloatX3# a1 a2 a3) = FloatX3# (tanFloat# a1)- (tanFloat# a2)- (tanFloat# a3)- {-# INLINE tan #-}- asin (FloatX3# a1 a2 a3) = FloatX3# (asinFloat# a1)- (asinFloat# a2)- (asinFloat# a3)- {-# INLINE asin #-}- acos (FloatX3# a1 a2 a3) = FloatX3# (acosFloat# a1)- (acosFloat# a2)- (acosFloat# a3)- {-# INLINE acos #-}- atan (FloatX3# a1 a2 a3) = FloatX3# (atanFloat# a1)- (atanFloat# a2)- (atanFloat# a3)- {-# INLINE atan #-}- sinh (FloatX3# a1 a2 a3) = FloatX3# (sinFloat# a1)- (sinFloat# a2)- (sinFloat# a3)- {-# INLINE sinh #-}- cosh (FloatX3# a1 a2 a3) = FloatX3# (coshFloat# a1)- (coshFloat# a2)- (coshFloat# a3)- {-# INLINE cosh #-}- tanh (FloatX3# a1 a2 a3) = FloatX3# (tanhFloat# a1)- (tanhFloat# a2)- (tanhFloat# a3)- {-# INLINE tanh #-}- FloatX3# a1 a2 a3 ** FloatX3# b1 b2 b3 = FloatX3# (powerFloat# a1 b1)- (powerFloat# a2 b2)- (powerFloat# a3 b3)- {-# INLINE (**) #-}-- logBase x y = log y / log x- {-# INLINE logBase #-}- asinh x = log (x + sqrt (1.0+x*x))- {-# INLINE asinh #-}- acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))- {-# INLINE acosh #-}- atanh x = 0.5 * log ((1.0+x) / (1.0-x))- {-# INLINE atanh #-}----type instance ElemRep FloatX3 = 'FloatRep-type instance ElemPrim FloatX3 = Float#-instance PrimBytes FloatX3 where- toBytes (FloatX3# a1 a2 a3) = case runRW#- ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of- (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of- s2 -> case writeFloatArray# marr 1# a2 s2 of- s3 -> case writeFloatArray# marr 2# a3 s3 of- s4 -> unsafeFreezeByteArray# marr s4- ) of (# _, a #) -> (# 0#, 3#, a #)- {-# INLINE toBytes #-}- fromBytes (# off, _, arr #) = FloatX3#- (indexFloatArray# arr off)- (indexFloatArray# arr (off +# 1#))- (indexFloatArray# arr (off +# 2#))- {-# INLINE fromBytes #-}- byteSize _ = SIZEOF_HSFLOAT# *# 3#- {-# INLINE byteSize #-}- byteAlign _ = ALIGNMENT_HSFLOAT#- {-# INLINE byteAlign #-}- elementByteSize _ = SIZEOF_HSFLOAT#- {-# INLINE elementByteSize #-}- ix 0# (FloatX3# a1 _ _) = a1- ix 1# (FloatX3# _ a2 _) = a2- ix 2# (FloatX3# _ _ a3) = a3- ix _ _ = undefined- {-# INLINE ix #-}---instance ElementWise (Idx '[3]) Float FloatX3 where-- (!) (FloatX3# a1 _ _) ( 1 :! Z) = F# a1- (!) (FloatX3# _ a2 _) ( 2 :! Z) = F# a2- (!) (FloatX3# _ _ a3) ( 3 :! Z) = F# a3- (!) _ ( _ :! Z) = undefined- {-# INLINE (!) #-}-- broadcast (F# x) = FloatX3# x x x- {-# INLINE broadcast #-}-- ewmap f (FloatX3# x y z) = case (f (1:!Z) (F# x), f (2:!Z) (F# y), f (3:!Z) (F# z)) of- (F# r1, F# r2, F# r3) -> FloatX3# r1 r2 r3- {-# INLINE ewmap #-}-- ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z)) of (F# r1, F# r2, F# r3) -> FloatX3# r1 r2 r3- {-# INLINE ewgen #-}-- ewgenA f = (\(F# r1) (F# r2) (F# r3) -> FloatX3# r1 r2 r3)- <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z)- {-# INLINE ewgenA #-}-- ewfoldl f x0 (FloatX3# x y z) = f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)) (F# z)- {-# INLINE ewfoldl #-}-- ewfoldr f x0 (FloatX3# x y z) = f (1:!Z) (F# x) (f (2:!Z) (F# y) (f (3:!Z) (F# z) x0))- {-# INLINE ewfoldr #-}-- elementWise f (FloatX3# x y z) = (\(F# a) (F# b) (F# c) -> FloatX3# a b c)- <$> f (F# x) <*> f (F# y) <*> f (F# z)- {-# INLINE elementWise #-}-- indexWise f (FloatX3# x y z) = (\(F# a) (F# b) (F# c) -> FloatX3# a b c)- <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y) <*> f (3:!Z) (F# z)- {-# INLINE indexWise #-}-- update (1 :! Z) (F# q) (FloatX3# _ y z) = FloatX3# q y z- update (2 :! Z) (F# q) (FloatX3# x _ z) = FloatX3# x q z- update (3 :! Z) (F# q) (FloatX3# x y _) = FloatX3# x y q- update (_ :! Z) _ x = x- {-# INLINE update #-}
− src/Numeric/Array/Family/FloatX4.hs
@@ -1,329 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--------------------------------------------------------------------------------- |--- Module : Numeric.Array.Family.FloatX4--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.FloatX4 () where---#include "MachDeps.h"--import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Float (..), RuntimeRep (..),- isTrue#)--import Numeric.Array.ElementWise-import Numeric.Array.Family-import Numeric.Commons-import Numeric.Dimensions------instance Show FloatX4 where- show (FloatX4# a1 a2 a3 a4) = "{ " ++ show (F# a1)- ++ ", " ++ show (F# a2)- ++ ", " ++ show (F# a3)- ++ ", " ++ show (F# a4)- ++ " }"----instance Eq FloatX4 where- FloatX4# a1 a2 a3 a4 == FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `eqFloat#` b1)- `andI#` (a2 `eqFloat#` b2)- `andI#` (a3 `eqFloat#` b3)- `andI#` (a4 `eqFloat#` b4)- )- {-# INLINE (==) #-}- FloatX4# a1 a2 a3 a4 /= FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `neFloat#` b1)- `orI#` (a2 `neFloat#` b2)- `orI#` (a3 `neFloat#` b3)- `orI#` (a4 `neFloat#` b4)- )- {-# INLINE (/=) #-}------ | Implement partial ordering for `>`, `<`, `>=`, `<=`--- and lexicographical ordering for `compare`-instance Ord FloatX4 where- FloatX4# a1 a2 a3 a4 > FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `gtFloat#` b1)- `andI#` (a2 `gtFloat#` b2)- `andI#` (a3 `gtFloat#` b3)- `andI#` (a4 `gtFloat#` b4)- )- {-# INLINE (>) #-}- FloatX4# a1 a2 a3 a4 < FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `ltFloat#` b1)- `andI#` (a2 `ltFloat#` b2)- `andI#` (a3 `ltFloat#` b3)- `andI#` (a4 `ltFloat#` b4)- )- {-# INLINE (<) #-}- FloatX4# a1 a2 a3 a4 >= FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `geFloat#` b1)- `andI#` (a2 `geFloat#` b2)- `andI#` (a3 `geFloat#` b3)- `andI#` (a4 `geFloat#` b4)- )- {-# INLINE (>=) #-}- FloatX4# a1 a2 a3 a4 <= FloatX4# b1 b2 b3 b4 = isTrue# ( (a1 `leFloat#` b1)- `andI#` (a2 `leFloat#` b2)- `andI#` (a3 `leFloat#` b3)- `andI#` (a4 `leFloat#` b4)- )- {-# INLINE (<=) #-}- -- | Compare lexicographically- compare (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4)- | isTrue# (a1 `gtFloat#` b1) = GT- | isTrue# (a1 `ltFloat#` b1) = LT- | isTrue# (a2 `gtFloat#` b2) = GT- | isTrue# (a2 `ltFloat#` b2) = LT- | isTrue# (a3 `gtFloat#` b3) = GT- | isTrue# (a3 `ltFloat#` b3) = LT- | isTrue# (a4 `gtFloat#` b4) = GT- | isTrue# (a4 `ltFloat#` b4) = LT- | otherwise = EQ- {-# INLINE compare #-}- -- | Element-wise minimum- min (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4) =- FloatX4# (if isTrue# (a1 `gtFloat#` b1) then b1 else a1)- (if isTrue# (a2 `gtFloat#` b2) then b2 else a2)- (if isTrue# (a3 `gtFloat#` b3) then b3 else a3)- (if isTrue# (a4 `gtFloat#` b4) then b4 else a4)- {-# INLINE min #-}- -- | Element-wise maximum- max (FloatX4# a1 a2 a3 a4) (FloatX4# b1 b2 b3 b4) =- FloatX4# (if isTrue# (a1 `gtFloat#` b1) then a1 else b1)- (if isTrue# (a2 `gtFloat#` b2) then a2 else b2)- (if isTrue# (a3 `gtFloat#` b3) then a3 else b3)- (if isTrue# (a4 `gtFloat#` b4) then a4 else b4)- {-# INLINE max #-}------ | element-wise operations for vectors-instance Num FloatX4 where- FloatX4# a1 a2 a3 a4 + FloatX4# b1 b2 b3 b4- = FloatX4# (plusFloat# a1 b1) (plusFloat# a2 b2) (plusFloat# a3 b3) (plusFloat# a4 b4)- {-# INLINE (+) #-}- FloatX4# a1 a2 a3 a4 - FloatX4# b1 b2 b3 b4- = FloatX4# (minusFloat# a1 b1) (minusFloat# a2 b2) (minusFloat# a3 b3) (minusFloat# a4 b4)- {-# INLINE (-) #-}- FloatX4# a1 a2 a3 a4 * FloatX4# b1 b2 b3 b4- = FloatX4# (timesFloat# a1 b1) (timesFloat# a2 b2) (timesFloat# a3 b3) (timesFloat# a4 b4)- {-# INLINE (*) #-}- negate (FloatX4# a1 a2 a3 a4)- = FloatX4# (negateFloat# a1) (negateFloat# a2) (negateFloat# a3) (negateFloat# a4)- {-# INLINE negate #-}- abs (FloatX4# a1 a2 a3 a4)- = FloatX4# (if isTrue# (a1 `geFloat#` 0.0#) then a1 else negateFloat# a1)- (if isTrue# (a2 `geFloat#` 0.0#) then a2 else negateFloat# a2)- (if isTrue# (a3 `geFloat#` 0.0#) then a3 else negateFloat# a3)- (if isTrue# (a4 `geFloat#` 0.0#) then a4 else negateFloat# a4)- {-# INLINE abs #-}- signum (FloatX4# a1 a2 a3 a4)- = FloatX4# (if isTrue# (a1 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a1 `ltFloat#` 0.0#) then -1.0# else 0.0# )- (if isTrue# (a2 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a2 `ltFloat#` 0.0#) then -1.0# else 0.0# )- (if isTrue# (a3 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a3 `ltFloat#` 0.0#) then -1.0# else 0.0# )- (if isTrue# (a4 `gtFloat#` 0.0#)- then 1.0#- else if isTrue# (a4 `ltFloat#` 0.0#) then -1.0# else 0.0# )- {-# INLINE signum #-}- fromInteger n = case fromInteger n of F# x -> FloatX4# x x x x- {-# INLINE fromInteger #-}----instance Fractional FloatX4 where- FloatX4# a1 a2 a3 a4 / FloatX4# b1 b2 b3 b4 = FloatX4# (divideFloat# a1 b1)- (divideFloat# a2 b2)- (divideFloat# a3 b3)- (divideFloat# a4 b4)- {-# INLINE (/) #-}- recip (FloatX4# a1 a2 a3 a4) = FloatX4# (divideFloat# 1.0# a1)- (divideFloat# 1.0# a2)- (divideFloat# 1.0# a3)- (divideFloat# 1.0# a4)- {-# INLINE recip #-}- fromRational r = case fromRational r of F# x -> FloatX4# x x x x- {-# INLINE fromRational #-}----instance Floating FloatX4 where- pi = FloatX4# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238# 3.141592653589793238#- {-# INLINE pi #-}- exp (FloatX4# a1 a2 a3 a4) = FloatX4# (expFloat# a1)- (expFloat# a2)- (expFloat# a3)- (expFloat# a4)- {-# INLINE exp #-}- log (FloatX4# a1 a2 a3 a4) = FloatX4# (logFloat# a1)- (logFloat# a2)- (logFloat# a3)- (logFloat# a4)- {-# INLINE log #-}- sqrt (FloatX4# a1 a2 a3 a4) = FloatX4# (sqrtFloat# a1)- (sqrtFloat# a2)- (sqrtFloat# a3)- (sqrtFloat# a4)- {-# INLINE sqrt #-}- sin (FloatX4# a1 a2 a3 a4) = FloatX4# (sinFloat# a1)- (sinFloat# a2)- (sinFloat# a3)- (sinFloat# a4)- {-# INLINE sin #-}- cos (FloatX4# a1 a2 a3 a4) = FloatX4# (cosFloat# a1)- (cosFloat# a2)- (cosFloat# a3)- (cosFloat# a4)- {-# INLINE cos #-}- tan (FloatX4# a1 a2 a3 a4) = FloatX4# (tanFloat# a1)- (tanFloat# a2)- (tanFloat# a3)- (tanFloat# a4)- {-# INLINE tan #-}- asin (FloatX4# a1 a2 a3 a4) = FloatX4# (asinFloat# a1)- (asinFloat# a2)- (asinFloat# a3)- (asinFloat# a4)- {-# INLINE asin #-}- acos (FloatX4# a1 a2 a3 a4) = FloatX4# (acosFloat# a1)- (acosFloat# a2)- (acosFloat# a3)- (acosFloat# a4)- {-# INLINE acos #-}- atan (FloatX4# a1 a2 a3 a4) = FloatX4# (atanFloat# a1)- (atanFloat# a2)- (atanFloat# a3)- (atanFloat# a4)- {-# INLINE atan #-}- sinh (FloatX4# a1 a2 a3 a4) = FloatX4# (sinFloat# a1)- (sinFloat# a2)- (sinFloat# a3)- (sinFloat# a4)- {-# INLINE sinh #-}- cosh (FloatX4# a1 a2 a3 a4) = FloatX4# (coshFloat# a1)- (coshFloat# a2)- (coshFloat# a3)- (coshFloat# a4)- {-# INLINE cosh #-}- tanh (FloatX4# a1 a2 a3 a4) = FloatX4# (tanhFloat# a1)- (tanhFloat# a2)- (tanhFloat# a3)- (tanhFloat# a4)- {-# INLINE tanh #-}- FloatX4# a1 a2 a3 a4 ** FloatX4# b1 b2 b3 b4 = FloatX4# (powerFloat# a1 b1)- (powerFloat# a2 b2)- (powerFloat# a3 b3)- (powerFloat# a4 b4)- {-# INLINE (**) #-}-- logBase x y = log y / log x- {-# INLINE logBase #-}- asinh x = log (x + sqrt (1.0+x*x))- {-# INLINE asinh #-}- acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))- {-# INLINE acosh #-}- atanh x = 0.5 * log ((1.0+x) / (1.0-x))- {-# INLINE atanh #-}----type instance ElemRep FloatX4 = 'FloatRep-type instance ElemPrim FloatX4 = Float#-instance PrimBytes FloatX4 where- toBytes (FloatX4# a1 a2 a3 a4) = case runRW#- ( \s0 -> case newByteArray# (SIZEOF_HSFLOAT# *# 3#) s0 of- (# s1, marr #) -> case writeFloatArray# marr 0# a1 s1 of- s2 -> case writeFloatArray# marr 1# a2 s2 of- s3 -> case writeFloatArray# marr 2# a3 s3 of- s4 -> case writeFloatArray# marr 3# a4 s4 of- s5 -> unsafeFreezeByteArray# marr s5- ) of (# _, a #) -> (# 0#, 4#, a #)- {-# INLINE toBytes #-}- fromBytes (# off, _, arr #) = FloatX4#- (indexFloatArray# arr off)- (indexFloatArray# arr (off +# 1#))- (indexFloatArray# arr (off +# 2#))- (indexFloatArray# arr (off +# 3#))- {-# INLINE fromBytes #-}- byteSize _ = SIZEOF_HSFLOAT# *# 4#- {-# INLINE byteSize #-}- byteAlign _ = ALIGNMENT_HSFLOAT#- {-# INLINE byteAlign #-}- elementByteSize _ = SIZEOF_HSFLOAT#- {-# INLINE elementByteSize #-}- ix 0# (FloatX4# a1 _ _ _) = a1- ix 1# (FloatX4# _ a2 _ _) = a2- ix 2# (FloatX4# _ _ a3 _) = a3- ix 3# (FloatX4# _ _ _ a4) = a4- ix _ _ = undefined- {-# INLINE ix #-}---instance ElementWise (Idx '[4]) Float FloatX4 where-- (!) (FloatX4# a1 _ _ _) ( 1 :! Z) = F# a1- (!) (FloatX4# _ a2 _ _) ( 2 :! Z) = F# a2- (!) (FloatX4# _ _ a3 _) ( 3 :! Z) = F# a3- (!) (FloatX4# _ _ _ a4) ( 4 :! Z) = F# a4- (!) _ ( _ :! Z) = undefined- {-# INLINE (!) #-}-- broadcast (F# x) = FloatX4# x x x x- {-# INLINE broadcast #-}-- ewmap f (FloatX4# x y z w) = case (f (1:!Z) (F# x), f (2:!Z) (F# y), f (3:!Z) (F# z), f (3:!Z) (F# w)) of- (F# r1, F# r2, F# r3, F# r4) -> FloatX4# r1 r2 r3 r4- {-# INLINE ewmap #-}-- ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z), f (4:!Z)) of (F# r1, F# r2, F# r3, F# r4) -> FloatX4# r1 r2 r3 r4- {-# INLINE ewgen #-}-- ewgenA f = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)- <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z) <*> f (4:!Z)- {-# INLINE ewgenA #-}-- ewfoldl f x0 (FloatX4# x y z w) = f (4:!Z) (f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (F# x)) (F# y)) (F# z)) (F# w)- {-# INLINE ewfoldl #-}-- ewfoldr f x0 (FloatX4# x y z w) = f (1:!Z) (F# x) (f (2:!Z) (F# y) (f (3:!Z) (F# z) (f (4:!Z) (F# w) x0)))- {-# INLINE ewfoldr #-}-- elementWise f (FloatX4# x y z w) = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)- <$> f (F# x) <*> f (F# y) <*> f (F# z) <*> f (F# w)- {-# INLINE elementWise #-}-- indexWise f (FloatX4# x y z w) = (\(F# a) (F# b) (F# c) (F# d) -> FloatX4# a b c d)- <$> f (1:!Z) (F# x) <*> f (2:!Z) (F# y) <*> f (3:!Z) (F# z) <*> f (4:!Z) (F# w)- {-# INLINE indexWise #-}-- update (1 :! Z) (F# q) (FloatX4# _ y z w) = FloatX4# q y z w- update (2 :! Z) (F# q) (FloatX4# x _ z w) = FloatX4# x q z w- update (3 :! Z) (F# q) (FloatX4# x y _ w) = FloatX4# x y q w- update (4 :! Z) (F# q) (FloatX4# x y z _) = FloatX4# x y z q- update (_ :! Z) _ x = x- {-# INLINE update #-}
src/Numeric/Commons.hs view
@@ -36,6 +36,7 @@ import GHC.Prim import GHC.Types (Double (..), Float (..), Int (..), RuntimeRep (..), Type, Word (..))+ import GHC.Word (Word16 (..), Word32 (..), Word64 (..), Word8 (..)) @@ -46,12 +47,20 @@ type instance ElemRep Int8 = 'IntRep type instance ElemRep Int16 = 'IntRep type instance ElemRep Int32 = 'IntRep+#if SIZEOF_HSWORD < 8+type instance ElemRep Int64 = 'Int64Rep+#else type instance ElemRep Int64 = 'IntRep+#endif type instance ElemRep Word = 'WordRep type instance ElemRep Word8 = 'WordRep type instance ElemRep Word16 = 'WordRep type instance ElemRep Word32 = 'WordRep+#if SIZEOF_HSWORD < 8+type instance ElemRep Word64 = 'Word64Rep+#else type instance ElemRep Word64 = 'WordRep+#endif type family ElemPrim a :: TYPE (r :: RuntimeRep) type instance ElemPrim Float = Float#@@ -60,13 +69,22 @@ type instance ElemPrim Int8 = Int# type instance ElemPrim Int16 = Int# type instance ElemPrim Int32 = Int#+#if SIZEOF_HSWORD < 8+type instance ElemPrim Int64 = Int64#+#else type instance ElemPrim Int64 = Int#+#endif type instance ElemPrim Word = Word# type instance ElemPrim Word8 = Word# type instance ElemPrim Word16 = Word# type instance ElemPrim Word32 = Word#+#if SIZEOF_HSWORD < 8+type instance ElemPrim Word64 = Word64#+#else type instance ElemPrim Word64 = Word#+#endif + type FloatBytes a = (PrimBytes a, ElemRep a ~ 'FloatRep , ElemPrim a ~ Float#) type DoubleBytes a = (PrimBytes a, ElemRep a ~ 'DoubleRep, ElemPrim a ~ Double#) type IntBytes a = (PrimBytes a, ElemRep a ~ 'IntRep , ElemPrim a ~ Int#)@@ -200,6 +218,7 @@ ix _ (I32# x) = x {-# INLINE ix #-} +#ifndef ghcjs_HOST_OS instance PrimBytes Int64 where toBytes v@(I64# x) = case runRW# ( \s0 -> case newByteArray# (byteSize v) s0 of@@ -217,6 +236,7 @@ {-# INLINE elementByteSize #-} ix _ (I64# x) = x {-# INLINE ix #-}+#endif instance PrimBytes Word where toBytes v@(W# x) = case runRW#@@ -291,6 +311,7 @@ {-# INLINE ix #-} +#ifndef ghcjs_HOST_OS instance PrimBytes Word64 where toBytes v@(W64# x) = case runRW# ( \s0 -> case newByteArray# (byteSize v) s0 of@@ -308,3 +329,5 @@ {-# INLINE elementByteSize #-} ix _ (W64# x) = x {-# INLINE ix #-}+#endif+
− src/Numeric/DataFrame/Contraction.hs
@@ -1,535 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}--------------------------------------------------------------------------------- |--- Module : Numeric.DataFrame.Contraction--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch------ This modules provides generalization of a matrix product:--- tensor-like contraction.--- For matrices and vectors this is a normal matrix*matrix or vector*matrix or matrix*vector product,--- for larger dimensions it calculates the scalar product of "adjacent" dimesnions of a tensor.-----------------------------------------------------------------------------------module Numeric.DataFrame.Contraction- ( Contraction (..), (%*)- ) where---import Data.Int (Int16, Int32, Int64, Int8)-import Data.Type.Equality ((:~:) (..))-import Data.Word (Word16, Word32, Word64, Word8)-import GHC.Base (runRW#)-import GHC.Prim-import GHC.Types (Int (..), RuntimeRep (..), Type,- Word (..), isTrue#)-import Unsafe.Coerce (unsafeCoerce)--import Numeric.Array.Family-import Numeric.Commons-import Numeric.DataFrame.Type-import Numeric.Dimensions-import Numeric.TypeLits---class ConcatList as bs asbs- => Contraction (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])- | asbs as -> bs, asbs bs -> as, as bs -> asbs where- -- | Generalization of a matrix product: take scalar product over one dimension- -- and, thus, concatenate other dimesnions- contract :: ( KnownDim m- , PrimBytes (DataFrame t (as +: m))- , PrimBytes (DataFrame t (m :+ bs))- , PrimBytes (DataFrame t asbs)- )- => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs---- | Tensor contraction.--- In particular:--- 1. matrix-matrix product--- 2. matrix-vector or vector-matrix product--- 3. dot product of two vectors.-(%*) :: ( ConcatList as bs (as ++ bs)- , Contraction t as bs asbs- , KnownDim m- , PrimBytes (DataFrame t (as +: m))- , PrimBytes (DataFrame t (m :+ bs))- , PrimBytes (DataFrame t (as ++ bs))- ) => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t (as ++ bs)-(%*) = contract-{-# INLINE (%*) #-}-infixl 7 %*-------------------------------------------------------------------------------------instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Float as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Float (m : bs) ) :~: 'FloatRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Float (m : bs) ) :~: Float#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Float (as +: m)) :~: 'FloatRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Float (as +: m)) :~: Float#- = prodF n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy---instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Double as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Double (m : bs) ) :~: 'DoubleRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Double (m : bs) ) :~: Double#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Double (as +: m)) :~: 'DoubleRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Double (as +: m)) :~: Double#- = prodD n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Int as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int (m : bs) ) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int (m : bs) ) :~: Int#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int (as +: m)) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int (as +: m)) :~: Int#- = prodI n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Int8 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int8 (m : bs) ) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int8 (m : bs) ) :~: Int#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int8 (as +: m)) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int8 (as +: m)) :~: Int#- = prodI8 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Int16 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int16 (m : bs) ) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int16 (m : bs) ) :~: Int#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int16 (as +: m)) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int16 (as +: m)) :~: Int#- = prodI16 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Int32 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int32 (m : bs) ) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int32 (m : bs) ) :~: Int#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int32 (as +: m)) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int32 (as +: m)) :~: Int#- = prodI32 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Int64 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int64 (m : bs) ) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (m : bs) ) :~: Int#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Int64 (as +: m)) :~: 'IntRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (as +: m)) :~: Int#- = prodI64 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy-----instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Word as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word (m : bs) ) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word (m : bs) ) :~: Word#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word (as +: m)) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word (as +: m)) :~: Word#- = prodW n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Word8 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word8 (m : bs) ) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word8 (m : bs) ) :~: Word#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word8 (as +: m)) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word8 (as +: m)) :~: Word#- = prodW8 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Word16 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word16 (m : bs) ) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word16 (m : bs) ) :~: Word#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word16 (as +: m)) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word16 (as +: m)) :~: Word#- = prodW16 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Word32 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word32 (m : bs) ) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word32 (m : bs) ) :~: Word#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word32 (as +: m)) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word32 (as +: m)) :~: Word#- = prodW32 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy--instance ( ConcatList as bs asbs- , Dimensions as- , Dimensions bs- ) => Contraction Word64 as bs asbs where- contract x y- | (pm :: Proxy m) <- getM y- , I# m <- intNatVal pm- , I# n <- totalDim (Proxy @as)- , I# k <- totalDim (Proxy @bs)- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word64 (m : bs) ) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (m : bs) ) :~: Word#- , Refl <- unsafeCoerce Refl :: ElemRep (Array Word64 (as +: m)) :~: 'WordRep- , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (as +: m)) :~: Word#- = prodW64 n m k x y- where- getM :: forall m p . p (m ': bs) -> Proxy m- getM _ = Proxy------prodF :: (FloatBytes a, FloatBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodF n m k x y = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r `plusFloat#` timesFloat# (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeFloatArray# marr (i +# n *# j) (loop' i j 0# 0.0#) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodF #-}--prodD :: (DoubleBytes a, DoubleBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodD n m k x y= case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r +## (*##) (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeDoubleArray# marr (i +# n *# j) (loop' i j 0# 0.0##) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodD #-}--prodI :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodI n m k x y= case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeIntArray# marr (i +# n *# j) (loop' i j 0# 0#) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodI #-}--prodI8 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodI8 n m k x y= case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeInt8Array# marr (i +# n *# j) (loop' i j 0# 0#) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodI8 #-}---prodI16 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodI16 n m k x y= case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeInt16Array# marr (i +# n *# j) (loop' i j 0# 0#) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodI16 #-}---prodI32 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodI32 n m k x y= case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeInt32Array# marr (i +# n *# j) (loop' i j 0# 0#) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodI32 #-}---prodI64 :: (IntBytes a, IntBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodI64 n m k x y= case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r +# (*#) (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeInt64Array# marr (i +# n *# j) (loop' i j 0# 0#) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodI64 #-}--prodW :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodW n m k x y = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeWordArray# marr (i +# n *# j) (loop' i j 0# 0##) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodW #-}--prodW8 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodW8 n m k x y = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeWord8Array# marr (i +# n *# j) (loop' i j 0# 0##) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodW8 #-}---prodW16 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodW16 n m k x y = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeWord16Array# marr (i +# n *# j) (loop' i j 0# 0##) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodW16 #-}--prodW32 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodW32 n m k x y = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeWord32Array# marr (i +# n *# j) (loop' i j 0# 0##) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodW32 #-}--prodW64 :: (WordBytes a, WordBytes b, PrimBytes c) => Int# -> Int# -> Int# -> a -> b -> c-prodW64 n m k x y = case runRW#- ( \s0 -> case newByteArray# bs s0 of- (# s1, marr #) ->- let loop' i j l r | isTrue# (l ==# m) = r- | otherwise = loop' i j (l +# 1#) (r `plusWord#` timesWord# (ix (i +# n *# l) x)- (ix (l +# m *# j) y))- in case loop2# n k- (\i j s' -> writeWord64Array# marr (i +# n *# j) (loop' i j 0# 0##) s'- ) s1 of- s2 -> unsafeFreezeByteArray# marr s2- ) of (# _, r #) -> fromBytes (# 0#, n *# k, r #)- where- bs = n *# k *# elementByteSize x-{-# INLINE prodW64 #-}----- | Do something in a loop for int i from 0 to n-1 and j from 0 to m-1-loop2# :: Int# -> Int# -> (Int# -> Int#-> State# s -> State# s) -> State# s -> State# s-loop2# n m f = loop' 0# 0#- where- loop' i j s | isTrue# (j ==# m) = s- | isTrue# (i ==# n) = loop' 0# (j +# 1#) s- | otherwise = case f i j s of s1 -> loop' (i +# 1#) j s1-{-# INLINE loop2# #-}----- contract' :: forall (t :: Type) (m :: Nat) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat])--- . ( ToList asbs ~ SimplifyList ('Concat (ToList as) (ToList bs))--- , ToList as ~ SimplifyList ('Prefix (ToList bs) (ToList asbs))--- , ToList bs ~ SimplifyList ('Suffix (ToList as) (ToList asbs))--- , Dimensions asbs--- , Dimensions (as +: m)--- , Dimensions (m :+ bs)--- , KnownDim m--- , ElementDataType t--- )--- => DataFrame t (as +: m) -> DataFrame t (m :+ bs) -> DataFrame t asbs--- contract' x y = case dim @asbs of--- D -> case ( unsafeCoerce Refl :: as :~: '[]--- , unsafeCoerce Refl :: bs :~: '[]--- ) of--- (Refl, Refl) -> case edtRefl (Proxy @t) of--- EDTFloat -> contract x y--- _ :* (sbs :: Dim (sbs :: [Nat])) -> case edtRefl (Proxy @t) of--- EDTFloat -> contract x y- -- case ( unsafeCoerce Refl :: EvalConsNat (SimplifyList (ToListNat sbs)) :~: sbs- -- , unsafeCoerce Refl :: SimplifyList (ToListNat bs) :~: ToListNat bs- -- , unsafeCoerce Refl :: ToList (as +: m) :~: SimplifyList (ToList (as +: m))- -- ) of- -- (Refl, Refl, Refl) -> case edtRefl (Proxy @t) of- -- EDTFloat -> contract x y
− src/Numeric/DataFrame/Inference.hs
@@ -1,140 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--------------------------------------------------------------------------------- |--- Module : Numeric.DataFrame.Inference--- Copyright : (c) Artem Chirkin--- License : BSD3------ Maintainer : chirkin@arch.ethz.ch------ The module provides data types and functions to infer typeclasses at runtime.-----------------------------------------------------------------------------------module Numeric.DataFrame.Inference- ( PrimBytesEvidence, inferPrimBytes- , ElementWiseEvidence, inferElementWise- , NumericFrameEvidence, inferNumericFrame- ) where--import Numeric.Array-import Numeric.Array.ElementWise-import Numeric.Commons-import Numeric.DataFrame.Type-import Numeric.Dimensions----- | Evidence for PrimBytes class-type PrimBytesEvidence t (ds :: [Nat])- = Evidence (PrimBytes (DataFrame t ds))---- | Evidence for ElementWise class-type ElementWiseEvidence t (ds :: [Nat])- = Evidence (ElementWise (Idx ds) t (DataFrame t ds))---- | Allow all common operations on available data frames-type NumericFrameEvidence t (ds :: [Nat])- = Evidence ( NumericFrame t ds)--inferPrimBytes :: forall t (ds :: [Nat])- . ( ArrayInstanceInference t ds- , Dimensions ds- )- => PrimBytesEvidence t ds-inferPrimBytes = case getArrayInstance @t @ds of- AIScalar -> case elemTypeInstance @t of- ETFloat -> Evidence- ETDouble -> Evidence- ETInt -> Evidence- ETInt8 -> Evidence- ETInt16 -> Evidence- ETInt32 -> Evidence- ETInt64 -> Evidence- ETWord -> Evidence- ETWord8 -> Evidence- ETWord16 -> Evidence- ETWord32 -> Evidence- ETWord64 -> Evidence- AIArrayF -> Evidence- AIArrayD -> Evidence- AIArrayI -> Evidence- AIArrayI8 -> Evidence- AIArrayI16 -> Evidence- AIArrayI32 -> Evidence- AIArrayI64 -> Evidence- AIArrayW -> Evidence- AIArrayW8 -> Evidence- AIArrayW16 -> Evidence- AIArrayW32 -> Evidence- AIArrayW64 -> Evidence- AIFloatX2 -> Evidence- AIFloatX3 -> Evidence- AIFloatX4 -> Evidence--inferElementWise :: forall t (ds :: [Nat])- . ( ArrayInstanceInference t ds- , Dimensions ds- )- => ElementWiseEvidence t ds-inferElementWise = case getArrayInstance @t @ds of- AIScalar -> Evidence- AIArrayF -> Evidence- AIArrayD -> Evidence- AIArrayI -> Evidence- AIArrayI8 -> Evidence- AIArrayI16 -> Evidence- AIArrayI32 -> Evidence- AIArrayI64 -> Evidence- AIArrayW -> Evidence- AIArrayW8 -> Evidence- AIArrayW16 -> Evidence- AIArrayW32 -> Evidence- AIArrayW64 -> Evidence- AIFloatX2 -> Evidence- AIFloatX3 -> Evidence- AIFloatX4 -> Evidence---inferNumericFrame :: forall t (ds :: [Nat])- . ( ArrayInstanceInference t ds- , Dimensions ds- )- => NumericFrameEvidence t ds-inferNumericFrame- | Evidence <- inferDimKnownDims @ds +!+ inferDimFiniteList @ds- = case getArrayInstance @t @ds of- AIFloatX2 -> Evidence- AIFloatX3 -> Evidence- AIFloatX4 -> Evidence- AIScalar -> case elemTypeInstance @t of- ETFloat -> Evidence- ETDouble -> Evidence- ETInt -> Evidence- ETInt8 -> Evidence- ETInt16 -> Evidence- ETInt32 -> Evidence- ETInt64 -> Evidence- ETWord -> Evidence- ETWord8 -> Evidence- ETWord16 -> Evidence- ETWord32 -> Evidence- ETWord64 -> Evidence- AIArrayF -> Evidence- AIArrayD -> Evidence- AIArrayI -> Evidence- AIArrayI8 -> Evidence- AIArrayI16 -> Evidence- AIArrayI32 -> Evidence- AIArrayI64 -> Evidence- AIArrayW -> Evidence- AIArrayW8 -> Evidence- AIArrayW16 -> Evidence- AIArrayW32 -> Evidence- AIArrayW64 -> Evidence
src/Numeric/DataFrame/SubSpace.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -14,6 +15,10 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-}+#ifdef ghcjs_HOST_OS+{-# LANGUAGE JavaScriptFFI #-}+{-# LANGUAGE UnliftedFFITypes #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Numeric.DataFrame.SubSpace@@ -35,6 +40,10 @@ import GHC.Prim import GHC.Types (Int (..), Type) +#ifdef ghcjs_HOST_OS+import GHCJS.Types (JSVal)+import Unsafe.Coerce (unsafeCoerce)+#endif import qualified Numeric.Array.ElementWise as EW import Numeric.Commons@@ -45,18 +54,31 @@ import Numeric.Scalar -- | Operations on DataFrames--- as is an element dimensionality--- bs is an indexing dimensionality--- t is an underlying data type (i.e. Float, Int, Double) --+-- @as@ is an element dimensionality+--+-- @bs@ is an indexing dimensionality+--+-- @t@ is an underlying data type (i.e. Float, Int, Double)+-- class ( ConcatList as bs asbs , Dimensions as , Dimensions bs , Dimensions asbs ) => SubSpace (t :: Type) (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) | asbs as -> bs, asbs bs -> as, as bs -> asbs where- -- | Get an element+ -- | Unsafely get a sub-dataframe by its primitive element subset.+ -- The offset is not checked to be aligned to the space structure or for bounds.+ -- Arguments are zero-based element offset and element size (aka `totalDim` of sub dataframe)+ --+ -- Normal indexing can be expressed in terms of `indexOffset#`:+ --+ -- > i !. x = case (# dimVal (dim @as), fromEnum i #) of (# I# n, I# j #) -> indexOffset# (n *# j) n x+ indexOffset# :: Int# -> Int# -> DataFrame t asbs -> DataFrame t as+ -- | Get an element by its index in the dataframe (!.) :: Idx bs -> DataFrame t asbs -> DataFrame t as+ (!.) i = case (# dimVal (dim @as), fromEnum i #) of (# I# n, I# j #) -> indexOffset# (n *# j) n+ {-# INLINE (!.) #-} -- | Set a new value to an element update :: Idx bs -> DataFrame t as -> DataFrame t asbs -> DataFrame t asbs -- | Map a function over each element of DataFrame@@ -174,6 +196,9 @@ {-# INLINE ewzip #-} +#ifdef ghcjs_HOST_OS+foreign import javascript unsafe "$3.subarray($1,$1 + $2)" js_subarray :: Int# -> Int# -> JSVal -> JSVal+#endif instance {-# OVERLAPPABLE #-} ( ConcatList as bs asbs@@ -185,15 +210,28 @@ , as ~ (a'' ': as'') , asbs ~ (a'' ': asbs'') ) => SubSpace t (as :: [Nat]) (bs :: [Nat]) (asbs :: [Nat]) where-- i !. d = r- where- r = case (# toBytes d, fromEnum i, totalDim r #) of- (# (# off, _, arr #), I# i#, I# l# #)- -> fromBytes (# off +# i# *# l#, l#, arr #)- {-# INLINE (!.) #-}+#ifdef ghcjs_HOST_OS+ indexOffset# i l = unsafeCoerce . js_subarray i l . unsafeCoerce+#else+ indexOffset# i l d = case toBytes d of+ (# off, _, arr #) -> fromBytes (# off +# i, l, arr #)+#endif+ {-# INLINE indexOffset# #-} - ewmap = iwmap . const+ ewmap f df+ | elS <- elementByteSize (undefined :: DataFrame t asbs)+ , I# lenBS <- totalDim (Proxy @bs)+ , I# lenAS <- totalDim (Proxy @as)+ , lenASB <- lenAS *# elS+ = case runRW#+ ( \s0 -> case newByteArray# (lenAS *# lenBS *# elS) s0 of+ (# s1, marr #) -> case overDimOff_#+ (dim @bs)+ ( \pos s -> case toBytes $ f (indexOffset# pos lenAS df) of+ (# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr (pos *# elS) lenASB s+ ) 0# lenAS s1 of+ s2 -> unsafeFreezeByteArray# marr s2+ ) of (# _, r #) -> fromBytes (# 0#, lenAS *# lenBS, r #) {-# INLINE ewmap #-} iwmap f df@@ -205,9 +243,9 @@ ( \s0 -> case newByteArray# (lenAS *# lenBS *# elS) s0 of (# s1, marr #) -> case overDim_# (dim @bs)- ( \i pos s -> case toBytes $ f i (i !. df) of- (# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr pos lenASB s- ) 0# lenASB s1 of+ ( \i pos s -> case toBytes $ f i (indexOffset# pos lenAS df) of+ (# offX, _, arrX #) -> copyByteArray# arrX (offX *# elS) marr (pos *# elS) lenASB s+ ) 0# lenAS s1 of s2 -> unsafeFreezeByteArray# marr s2 ) of (# _, r #) -> fromBytes (# 0#, lenAS *# lenBS, r #) @@ -334,6 +372,8 @@ , EW.ElementWise (Idx bs) t (DataFrame t bs) , PrimBytes (DataFrame t bs) ) => SubSpace t ('[] :: [Nat]) (bs :: [Nat]) (bs :: [Nat]) where+ indexOffset# i _ x = scalar (EW.indexOffset# x i)+ {-# INLINE indexOffset# #-} i !. x = scalar $ x EW.! i {-# INLINE (!.) #-} ewmap = iwmap . const
src/Numeric/DataFrame/Type.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}@@ -147,6 +148,8 @@ instance ( Dimensions ds , ElementWise (Idx ds) t (Array t ds) ) => ElementWise (Idx ds) t (DataFrame t ds) where+ indexOffset# = indexOffset# . _getDF+ {-# INLINE indexOffset# #-} (!) = (!) . _getDF {-# INLINE (!) #-} ewmap f = KnownDataFrame . ewmap f . _getDF@@ -206,12 +209,18 @@ type instance ElemPrim (DataFrame Int8 ds) = Int# type instance ElemPrim (DataFrame Int16 ds) = Int# type instance ElemPrim (DataFrame Int32 ds) = Int#+#ifndef ghcjs_HOST_OS type instance ElemPrim (DataFrame Int64 ds) = Int#+#endif type instance ElemPrim (DataFrame Word ds) = Word# type instance ElemPrim (DataFrame Word8 ds) = Word# type instance ElemPrim (DataFrame Word16 ds) = Word# type instance ElemPrim (DataFrame Word32 ds) = Word#+#ifdef ghcjs_HOST_OS+type instance ElemPrim (DataFrame Word8Clamped ds) = Int#+#else type instance ElemPrim (DataFrame Word64 ds) = Word#+#endif deriving instance ( PrimBytes (Array Float ds) , ElemPrim (Array Float ds) ~ Float# , ElemRep (Array Float ds) ~ 'FloatRep) => PrimBytes (DataFrame Float ds)@@ -230,9 +239,11 @@ deriving instance ( PrimBytes (Array Int32 ds) , ElemPrim (Array Int32 ds) ~ Int# , ElemRep (Array Int32 ds) ~ 'IntRep) => PrimBytes (DataFrame Int32 ds)+#ifndef ghcjs_HOST_OS deriving instance ( PrimBytes (Array Int64 ds) , ElemPrim (Array Int64 ds) ~ Int# , ElemRep (Array Int64 ds) ~ 'IntRep) => PrimBytes (DataFrame Int64 ds)+#endif deriving instance ( PrimBytes (Array Word ds) , ElemPrim (Array Word ds) ~ Word# , ElemRep (Array Word ds) ~ 'WordRep) => PrimBytes (DataFrame Word ds)@@ -245,9 +256,15 @@ deriving instance ( PrimBytes (Array Word32 ds) , ElemPrim (Array Word32 ds) ~ Word# , ElemRep (Array Word32 ds) ~ 'WordRep) => PrimBytes (DataFrame Word32 ds)+#ifdef ghcjs_HOST_OS+deriving instance ( PrimBytes (Array Word8Clamped ds)+ , ElemPrim (Array Word8Clamped ds) ~ Int#+ , ElemRep (Array Word8Clamped ds) ~ 'IntRep) => PrimBytes (DataFrame Word8Clamped ds)+#else deriving instance ( PrimBytes (Array Word64 ds) , ElemPrim (Array Word64 ds) ~ Word# , ElemRep (Array Word64 ds) ~ 'WordRep) => PrimBytes (DataFrame Word64 ds)+#endif
src/Numeric/Matrix/Type.hs view
@@ -40,7 +40,7 @@ -- | Put the same value on the Mat diagonal, 0 otherwise diag :: Scalar t -> Matrix t n n -- | Determinant of Mat- det :: Matrix t n n -> t+ det :: Matrix t n n -> Scalar t -- | Sum of diagonal elements trace :: Matrix t n n -> Scalar t