easytensor 0.4.0.0 → 1.0.0.0

raw patch · 81 files changed

+7678/−13722 lines, 81 filesdep −ghc-primdep −ghcjs-basedep ~Cabaldep ~basedep ~dimensionsPVP ok

version bump matches the API change (PVP)

Dependencies removed: ghc-prim, ghcjs-base

Dependency ranges changed: Cabal, base, dimensions

API changes (from Hackage documentation)

Files

• bench/misc.hs +24/−18
• bench/subspacefolds.hs +3/−3
• bench/tuple.hs +0/−57
• easytensor.cabal +28/−72
• src-base/Numeric/Array.hs +0/−37
• src-base/Numeric/Array/Family.hs +0/−496
• src-base/Numeric/Array/Family/Array.h +0/−308
• src-base/Numeric/Array/Family/ArrayD.hs +0/−414
• src-base/Numeric/Array/Family/ArrayF.hs +0/−418
• src-base/Numeric/Array/Family/ArrayI.hs +0/−95
• src-base/Numeric/Array/Family/ArrayI16.hs +0/−96
• src-base/Numeric/Array/Family/ArrayI32.hs +0/−96
• src-base/Numeric/Array/Family/ArrayI64.hs +0/−127
• src-base/Numeric/Array/Family/ArrayI8.hs +0/−96
• src-base/Numeric/Array/Family/ArrayW.hs +0/−89
• src-base/Numeric/Array/Family/ArrayW16.hs +0/−90
• src-base/Numeric/Array/Family/ArrayW32.hs +0/−90
• src-base/Numeric/Array/Family/ArrayW64.hs +0/−128
• src-base/Numeric/Array/Family/ArrayW8.hs +0/−90
• src-base/Numeric/Array/Family/DoubleX2.hs +0/−268
• src-base/Numeric/Array/Family/DoubleX3.hs +0/−304
• src-base/Numeric/Array/Family/DoubleX4.hs +0/−340
• src-base/Numeric/Array/Family/FloatX2.hs +0/−330
• src-base/Numeric/Array/Family/FloatX3.hs +0/−304
• src-base/Numeric/Array/Family/FloatX4.hs +0/−340
• src-base/Numeric/DataFrame/Contraction.hs +0/−576
• src-base/Numeric/DataFrame/Inference.hs +0/−150
• src-base/Numeric/DataFrame/Mutable.hs +0/−224
• src-base/Numeric/Matrix/Mat44d.hs +0/−37
• src-base/Numeric/Matrix/Mat44f.hs +0/−37
• src-base/Numeric/Quaternion/QDouble.hs +0/−542
• src-base/Numeric/Quaternion/QFloat.hs +0/−562
• src-ghcjs/Numeric/Array.hs +0/−18
• src-ghcjs/Numeric/Array/Family.hs +0/−360
• src-ghcjs/Numeric/Array/Family/ArrayT.hs +0/−1645
• src-ghcjs/Numeric/Array/Family/ArrayT.js +0/−488
• src-ghcjs/Numeric/DataFrame/Contraction.hs +0/−93
• src-ghcjs/Numeric/DataFrame/Inference.hs +0/−127
• src-ghcjs/Numeric/DataFrame/Mutable.hs +0/−296
• src-ghcjs/Numeric/Matrix/Mat44.js +0/−103
• src-ghcjs/Numeric/Matrix/Mat44d.hs +0/−69
• src-ghcjs/Numeric/Matrix/Mat44f.hs +0/−69
• src-ghcjs/Numeric/Quaternion/QDouble.hs +0/−285
• src-ghcjs/Numeric/Quaternion/QFloat.hs +0/−295
• src-ghcjs/Numeric/Quaternion/Quaternion.js +0/−205
• src/Numeric/Array/ElementWise.hs +0/−349
• src/Numeric/Commons.hs +0/−428
• src/Numeric/DataFrame.hs +3/−24
• src/Numeric/DataFrame/Contraction.hs +98/−0
• src/Numeric/DataFrame/Family.hs +9/−0
• src/Numeric/DataFrame/IO.hs +128/−269
• src/Numeric/DataFrame/Internal/Array.hs +26/−0
• src/Numeric/DataFrame/Internal/Array/Class.hs +51/−0
• src/Numeric/DataFrame/Internal/Array/Family.hs +216/−0
• src/Numeric/DataFrame/Internal/Array/Family/ArrayBase.hs +500/−0
• src/Numeric/DataFrame/Internal/Array/Family/DoubleX2.hs +333/−0
• src/Numeric/DataFrame/Internal/Array/Family/DoubleX3.hs +362/−0
• src/Numeric/DataFrame/Internal/Array/Family/DoubleX4.hs +391/−0
• src/Numeric/DataFrame/Internal/Array/Family/FloatX2.hs +333/−0
• src/Numeric/DataFrame/Internal/Array/Family/FloatX3.hs +362/−0
• src/Numeric/DataFrame/Internal/Array/Family/FloatX4.hs +420/−0
• src/Numeric/DataFrame/Internal/Array/Family/ScalarBase.hs +51/−0
• src/Numeric/DataFrame/Internal/Array/PrimOps.hs +94/−0
• src/Numeric/DataFrame/Internal/Mutable.hs +223/−0
• src/Numeric/DataFrame/ST.hs +106/−272
• src/Numeric/DataFrame/Shape.hs +147/−174
• src/Numeric/DataFrame/SubSpace.hs +154/−172
• src/Numeric/DataFrame/Type.hs +380/−230
• src/Numeric/Matrix.hs +276/−36
• src/Numeric/Matrix/Class.hs +53/−24
• src/Numeric/PrimBytes.hs +1428/−0
• src/Numeric/Quaternion/QDouble.hs +559/−0
• src/Numeric/Quaternion/QFloat.hs +579/−0
• src/Numeric/Scalar.hs +26/−20
• src/Numeric/Tuple.hs +0/−566
• src/Numeric/Vector.hs +71/−88
• test/Numeric/DataFrame/Arbitraries.hs +136/−118
• test/Numeric/DataFrame/BasicTest.hs +19/−16
• test/Numeric/DataFrame/SubSpaceTest.hs +26/−47
• test/Numeric/MatrixTest.hs +59/−0
• test/Spec.hs +4/−2

@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds        #-} {-# LANGUAGE GADTs            #-}-{-# LANGUAGE KindSignatures   #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators    #-} @@ -18,23 +17,30 @@ main :: IO () main = do     putStrLn "Hello world!"-    print (Dn @3 :* Dn @2 :* (D :: Dim ('[] :: [Nat])))+    print (D @3 :* D @2 :* U) -    print (fromList [vec2 1 0, vec2 2 3, vec2 3 4, vec2 5 6] :: DataFrame Int '[N 2, XN 2])-    print (fromList [vec4 1 0 2 11, vec4 2 22 3 0, vec4 3 4 0 0] :: DataFrame Double '[N 4, XN 2])-    print (fromList [vec2 0 0, vec2 2 22, vec2 2 22] :: DataFrame Float '[N 2, XN 2])-    print (fromList [0, 1, 3, 5, 7] :: DataFrame Float '[XN 2])-    print (fromList [9, 13, 2] :: DataFrame Float '[N 5, N 2, XN 2])-    print $ vec2 1 1 %* mat22 (vec2 1 1) (vec2 2 (3 :: Float))+    print (fromList D [vec2 1 0, vec2 2 3, vec2 3 4, vec2 5 6]+             :: Maybe (DataFrame Int '[N 2, XN 2]))+    print (fromList D [vec4 1 0 2 11, vec4 2 22 3 0, vec4 3 4 0 0]+             :: Maybe (DataFrame Double '[N 4, XN 0]))+    print (fromList D [vec2 0 0, vec2 2 22, vec2 2 22]+             :: Maybe (DataFrame Float '[N 2, XN 4]))+    print $ fromList (D @3) [0 :: Scf, 1, 3, 5, 7]+    print ( fromList D [9, 13, 2]+             :: Maybe (DataFrame Float '[N 5, N 2, XN 2]))+    print $ vec2 1 1 %* mat22 1 (vec2 2 (3 :: Float))     print (toList (42 :: DataFrame Int '[4,3,2]))     -- Seems like I have to specify known dimension explicitly,     -- because the inference process within the pattern match     -- cannot escape the case expression.     -- On the other hand, if I type wrong dimension it will throw a nice type-level error.-    () <- case fromList [10, 100, 1000] :: DataFrame Double '[N 4, N 2, XN 2] of-                    -- Amazing inference!-                    -- m :: KnownNat k => DataFrame '[4,2,k]-        SomeDataFrame m -> print $ vec4 1 2.25 3 0.162 %* m+    () <- case fromList D [10, 100, 1000] :: Maybe (DataFrame Double '[N 4, N 2, XN 2]) of+        Just (XFrame m)+          | KnownDims <- dims `inSpaceOf` m+              -- Amazing inference!+              -- m :: KnownNat k => DataFrame '[4,2,k]+            -> print $ vec4 1 2.25 3 0.162 %* m+        Nothing -> print "Failed to construct a DataFrame!"     putStrLn "Constructing larger matrices"     let x :: DataFrame Double '[2,5,4]         x =   transpose ( (56707.4   <::> 73558.41  <+:> 47950.074  <+:> 83394.61  <+:> 25611.629 )@@ -62,7 +68,7 @@     -- For example, we can do tensor produt of every sub-tensor.     putStrLn "\nConversions between element types and frame sizes."     print $ iwmap @Int @'[2,2] @'[7] @_-                  (\(i:!Z) v -> fromScalar . (scalar i +) . round+                  (\(Idx i:*U) v -> fromScalar . (scalar (fromIntegral i) +) . round                                      $ vec3 0.02 (-0.01) 0.001 %* v                   ) y @@ -77,8 +83,8 @@     print rVec      -- Updating existing frames-    print $ update (2:!Z) (scalar 777) rVec-    print $ update (2:!3:!Z) (vec2 999 999) x+    print $ update (2:*U) (scalar 777) rVec+    print $ update (2:*3:*U) (vec2 999 999) x      let matX = iwgen (scalar . fromEnum) :: DataFrame Int '[2,5,4]         matY = iwgen (scalar . fromEnum) :: DataFrame Int '[5,4]@@ -91,7 +97,7 @@     -- Working with mutable frames     print $ ST.runST $ do       sdf <- ST.thawDataFrame matY-      ST.writeDataFrame sdf (1:!1:!Z) 900101-      ST.writeDataFrame sdf (3:!3:!Z) 900303-      ST.writeDataFrame sdf (5:!3:!Z) 900503+      ST.writeDataFrame sdf (1:*1:*U) 900101+      ST.writeDataFrame sdf (3:*3:*U) 900303+      ST.writeDataFrame sdf (5:*3:*U) 900503       ST.unsafeFreezeDataFrame sdf

@@ -48,7 +48,7 @@      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 )) )+                          (\a x -> return $! fromMaybe 2 a + fromMaybe 0 a / (1 + iwgen @_ @'[] (\(Idx i:*U) -> Idx (i+1) :* U !. x )) )                           (Just (3 :: DataFrame Float '[5])) df     t6 <- rezEwv1 `seq` getCurrentTime     seq t6 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t6 t5)@@ -56,7 +56,7 @@      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 )))+                          (\x a -> return $! fromMaybe 2 a + fromMaybe 1 a / (1 + iwgen @_ @'[] (\(Idx i:*U) -> Idx (i+1):* U !. x )))                           (Just (3 :: DataFrame Float '[3])) df     t7 <- rezEwv2 `seq` getCurrentTime     seq t7 putStrLn $ "Done; elapsed time = " ++ show (diffUTCTime t7 t6)@@ -74,4 +74,4 @@       putStrLn "Checking indexes"-    print $ 2:!1:!1:!3:!1:!Z !. df+    print $ 2:*1:*1:*3:*1:*U !. df

@@ -1,57 +0,0 @@-module Main (main) where--import Data.Time.Clock-import Numeric.Semigroup-import Numeric.Tuple---main :: IO ()-main = do-    let n = 10000000 :: Int-        one = 1 :: Int-    bench "MaxTup0Fold" $-      fromTuple $ foldMap' (const T0) [1..n]-    bench "MaxFold" $-      foldMap' Max [1..n]-    bench "MaxTupFold" $-      foldMap' (T1 <$> Max) [1..n]-    bench "MaxSumFold" $-      fromTuple $ foldMap' (T2 <$> Max <*> Sum) [1..n]-    bench "MaxSumMinFold" $-      fromTuple $ foldMap' (T3 <$> Max <*> Sum <*> Min) [1..n]-    bench "MaxSumMinMinMaxFold" $-      fromTuple $ foldMap' (T4 <$> Max <*> Sum <*> Min <*> minMax) [1..n]-    bench "MaxSumMinMinMaxAllFold" $-      fromTuple $ foldMap' (T5 <$> Max-                               <*> Sum . (`mod` 19)-                               <*> Min . (`mod` 23)-                               <*> minMax-                               <*> (All . (>0))-                            ) [1..n]-    bench "MaxSumMinMinMaxAllCountFold" $-      fromTuple $ foldMap' (T6 <$> Max-                               <*> Sum . (`mod` 19)-                               <*> Min . (`mod` 23)-                               <*> minMax-                               <*> (All . (>0))-                               <*> (Sum . const one)-                            ) [1..n]-    bench "MaxSumMinMinMaxAllCountProdFold" $-      fromTuple $ foldMap' (T7 <$> Max-                               <*> Sum . (`mod` 19)-                               <*> Min . (`mod` 23)-                               <*> minMax-                               <*> (All . (>0))-                               <*> (Sum . const one)-                               <*> Product . (+1) . (*(-2)) . (`mod` 2)-                            ) [1..n]-----bench :: Show a => String -> a -> IO ()-bench bname v = do-    t0 <- getCurrentTime-    t1 <- t0 `seq` v `seq` putStrLn ("Evaluated " <> bname <> ":") >> print v >> getCurrentTime-    seq t1 putStrLn $ "Execution time: " <> show (diffUTCTime t1 t0)-    putStrLn ""

@@ -1,6 +1,6 @@ name: easytensor-version: 0.4.0.0-cabal-version: >=1.20+version: 1.0.0.0+cabal-version: >=1.22 build-type: Simple license: BSD3 license-file: LICENSE@@ -15,8 +15,6 @@     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-base/Numeric/Array/Family/Array.h  source-repository head     type: git@@ -35,74 +33,46 @@     if flag(unsafeindices)         cpp-options: -DUNSAFE_INDICES     exposed-modules:-        Numeric.Commons         Numeric.DataFrame         Numeric.DataFrame.IO         Numeric.DataFrame.ST         Numeric.Matrix+        Numeric.Matrix.Class         Numeric.Vector         Numeric.Scalar         Numeric.Quaternion         Numeric.Semigroup-        Numeric.Tuple+        Numeric.PrimBytes+        Numeric.DataFrame.Type+        Numeric.DataFrame.Family+        Numeric.DataFrame.Shape+        Numeric.DataFrame.SubSpace+        Numeric.DataFrame.Contraction+        Numeric.DataFrame.Internal.Mutable+        Numeric.DataFrame.Internal.Array+        Numeric.DataFrame.Internal.Array.Class+        Numeric.DataFrame.Internal.Array.Family+        Numeric.DataFrame.Internal.Array.Family.ArrayBase+        Numeric.DataFrame.Internal.Array.Family.ScalarBase+        Numeric.DataFrame.Internal.Array.Family.FloatX2+        Numeric.DataFrame.Internal.Array.Family.FloatX3+        Numeric.DataFrame.Internal.Array.Family.FloatX4+        Numeric.DataFrame.Internal.Array.Family.DoubleX2+        Numeric.DataFrame.Internal.Array.Family.DoubleX3+        Numeric.DataFrame.Internal.Array.Family.DoubleX4+        Numeric.DataFrame.Internal.Array.PrimOps     build-depends:-        base >=4.9 && <5,-        ghc-prim >=0.5,-        dimensions -any-    if impl(ghcjs)-      build-depends:-        ghcjs-base >= 0.2.0.0+        base >=4.10 && <5,+        dimensions >=1.0.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.Class-        Numeric.Matrix.Mat44d-        Numeric.Matrix.Mat44f         Numeric.Quaternion.Class         Numeric.Quaternion.QDouble         Numeric.Quaternion.QFloat-    if impl(ghcjs)-      other-modules:-        Numeric.Array.Family.ArrayT-    else-      other-modules:-        Numeric.Array.Family.ArrayF-        Numeric.Array.Family.ArrayD-        Numeric.Array.Family.ArrayI-        Numeric.Array.Family.ArrayI8-        Numeric.Array.Family.ArrayI16-        Numeric.Array.Family.ArrayI32-        Numeric.Array.Family.ArrayI64-        Numeric.Array.Family.ArrayW-        Numeric.Array.Family.ArrayW8-        Numeric.Array.Family.ArrayW16-        Numeric.Array.Family.ArrayW32-        Numeric.Array.Family.ArrayW64-        Numeric.Array.Family.FloatX2-        Numeric.Array.Family.FloatX3-        Numeric.Array.Family.FloatX4-        Numeric.Array.Family.DoubleX2-        Numeric.Array.Family.DoubleX3-        Numeric.Array.Family.DoubleX4-    js-sources:-        src-ghcjs/Numeric/Array/Family/ArrayT.js-        src-ghcjs/Numeric/Quaternion/Quaternion.js-        src-ghcjs/Numeric/Matrix/Mat44.js-    ghc-options: -Wall -fwarn-tabs -fwarn-unused-do-bind -fwarn-monomorphism-restriction -O2+    ghc-options: -Wall -fwarn-tabs -fwarn-unused-do-bind -fwarn-monomorphism-restriction + test-suite et-test      type: exitcode-stdio-1.0@@ -111,10 +81,11 @@         Numeric.DataFrame.Arbitraries         Numeric.DataFrame.SubSpaceTest         Numeric.DataFrame.BasicTest+        Numeric.MatrixTest         Numeric.QuaternionTest     build-depends:         base -any,-        Cabal >=1.20,+        Cabal -any,         QuickCheck -any,         easytensor -any,         dimensions -any@@ -123,7 +94,6 @@     ghc-options: -Wall -fwarn-tabs -O2  - benchmark et-bench-misc      type: exitcode-stdio-1.0@@ -137,24 +107,10 @@     ghc-options: -Wall -fwarn-tabs -O2  - benchmark et-bench-spfolds      type: exitcode-stdio-1.0     main-is: subspacefolds.hs-    build-depends:-        base -any,-        easytensor -any,-        dimensions -any,-        time -any-    default-language: Haskell2010-    hs-source-dirs: bench-    ghc-options: -Wall -fwarn-tabs -O2--benchmark et-tuple--    type: exitcode-stdio-1.0-    main-is: tuple.hs     build-depends:         base -any,         easytensor -any,

@@ -1,37 +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   ()--import           Numeric.Array.Family.DoubleX2  ()-import           Numeric.Array.Family.DoubleX3  ()-import           Numeric.Array.Family.DoubleX4  ()

@@ -1,496 +0,0 @@-{-# LANGUAGE CPP                        #-}-{-# 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 (..)-  , DoubleX2 (..), DoubleX3 (..), DoubleX4 (..)-  , ArrayInstanceInference, ElemType (..), ArraySize (..)-  , ElemTypeInference (..), ArraySizeInference (..), ArrayInstanceEvidence-  , getArrayInstance, ArrayInstance (..), inferArrayInstance-  ) where--#include "MachDeps.h"--import           Data.Int                  (Int16, Int32, Int64, Int8)-import           Data.Type.Equality        ((:~:) (..))-import           Data.Word                 (Word16, Word32, Word64, Word8)-import           GHC.Prim                  ( ByteArray#, Double#, Float#-#if WORD_SIZE_IN_BITS < 64-                                           , Int64#, Word64#-#endif-                                           , Int#, Word#, unsafeCoerce#)-import           GHC.Exts                  (RuntimeRep(..))--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 Double '[2]         = DoubleX2-  Array Double '[3]         = DoubleX3-  Array Double '[4]         = DoubleX4-  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 ( Enum, Eq, Integral-           , Num, Fractional, Floating, Ord, Read, Real, RealFrac, RealFloat)-instance Show t => Show (Scalar t) where-  show (Scalar t) = "{ " ++ show t ++ " }"--deriving instance {-# OVERLAPPABLE #-} Bounded t => Bounded (Scalar t)-instance {-# OVERLAPPING #-} Bounded (Scalar Double) where-  maxBound = Scalar inftyD-  minBound = Scalar $ negate inftyD-instance {-# OVERLAPPING #-} Bounded (Scalar Float) where-  maxBound = Scalar inftyF-  minBound = Scalar $ negate inftyF-inftyD :: Double-inftyD = read "Infinity"-inftyF :: Float-inftyF = read "Infinity"--type instance ElemRep (Scalar Float ) = 'FloatRep-type instance ElemRep (Scalar Double) = 'DoubleRep-type instance ElemRep (Scalar Int   ) = 'IntRep-type instance ElemRep (Scalar Int8  ) = 'IntRep-type instance ElemRep (Scalar Int16 ) = 'IntRep-type instance ElemRep (Scalar Int32 ) = 'IntRep-#if WORD_SIZE_IN_BITS < 64-type instance ElemRep (Scalar Int64 ) = 'Int64Rep-#else-type instance ElemRep (Scalar Int64 ) = 'IntRep-#endif-type instance ElemRep (Scalar Word  ) = 'WordRep-type instance ElemRep (Scalar Word8 ) = 'WordRep-type instance ElemRep (Scalar Word16) = 'WordRep-type instance ElemRep (Scalar Word32) = 'WordRep-#if WORD_SIZE_IN_BITS < 64-type instance ElemRep (Scalar Word64) = 'Word64Rep-#else-type instance ElemRep (Scalar Word64) = 'WordRep-#endif--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#-#if WORD_SIZE_IN_BITS < 64-type instance ElemPrim (Scalar Int64 ) = Int64#-#else-type instance ElemPrim (Scalar Int64 ) = Int#-#endif-type instance ElemPrim (Scalar Word  ) = Word#-type instance ElemPrim (Scalar Word8 ) = Word#-type instance ElemPrim (Scalar Word16) = Word#-type instance ElemPrim (Scalar Word32) = Word#-#if WORD_SIZE_IN_BITS < 64-type instance ElemPrim (Scalar Word64) = Word64#-#else-type instance ElemPrim (Scalar Word64) = Word#-#endif--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#-#if WORD_SIZE_IN_BITS < 64-data ArrayI64 (ds :: [Nat]) = ArrayI64# Int# Int# ByteArray#-                            | FromScalarI64# Int64#-#else-data ArrayI64 (ds :: [Nat]) = ArrayI64# Int# Int# ByteArray#-                            | FromScalarI64# Int#-#endif-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#-#if WORD_SIZE_IN_BITS < 64-data ArrayW64 (ds :: [Nat]) = ArrayW64# Int# Int# ByteArray#-                            | FromScalarW64# Word64#-#else-data ArrayW64 (ds :: [Nat]) = ArrayW64# Int# Int# ByteArray#-                            | FromScalarW64# Word#-#endif---- * 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#--data DoubleX2 = DoubleX2# Double# Double#-data DoubleX3 = DoubleX3# Double# Double# Double#-data DoubleX4 = DoubleX4# Double# Double# Double# Double#---- * 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-  | ( Array t ds ~ DoubleX2, ds ~ '[2], t ~ Double) => AIDoubleX2-  | ( Array t ds ~ DoubleX3, ds ~ '[3], t ~ Double) => AIDoubleX3-  | ( Array t ds ~ DoubleX4, ds ~ '[4], t ~ Double) => AIDoubleX4---- | 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) -> AIDoubleX2-    (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) -> AIDoubleX3-    (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) -> AIDoubleX4-    (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) -> unsafeCoerce# (AIArrayD :: ArrayInstance Double '[5])-    (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

@@ -1,308 +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-  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 #-}

@@ -1,414 +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.Class---#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 Bounded (ArrayD ds) where-  maxBound = broadcastArray infty-  minBound = broadcastArray $ negate infty--infty :: Double-infty = read "Infinity"--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# #-}

@@ -1,418 +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.Class--#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 Bounded (ArrayF ds) where-  maxBound = broadcastArray infty-  minBound = broadcastArray $ negate infty--infty :: Float-infty = read "Infinity"--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# #-}

@@ -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

@@ -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

@@ -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

@@ -1,127 +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--#include "MachDeps.h"-import           GHC.Base                  (runRW#)-import           GHC.Prim-import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)-import           GHC.Int                   (Int64 (..))-#if WORD_SIZE_IN_BITS < 64-import           GHC.IntWord64-#endif--import           Numeric.Array.ElementWise-import           Numeric.Array.Family-import           Numeric.Commons-import           Numeric.Dimensions-import           Numeric.Dimensions.Traverse----#if SIZEOF_HSWORD < 8-#define ARR_TYPE                 ArrayI64-#define ARR_FROMSCALAR           FromScalarI64#-#define ARR_CONSTR               ArrayI64#-#define EL_TYPE_BOXED            Int64-#define EL_TYPE_PRIM             Int64#-#define EL_RUNTIME_REP           'Int64Rep-#define EL_CONSTR                I64#-#define EL_SIZE                  SIZEOF_INT64#-#define EL_ALIGNMENT             ALIGNMENT_INT64#-#define EL_ZERO                  (intToInt64# 0#)-#define EL_ONE                   (intToInt64# 1#)-#define EL_MINUS_ONE             (intToInt64# (-1#))-#define INDEX_ARRAY              indexInt64Array#-#define WRITE_ARRAY              writeInt64Array#-#define OP_EQ                    (eqInt64#)-#define OP_NE                    (neInt64#)-#define OP_GT                    (gtInt64#)-#define OP_GE                    (geInt64#)-#define OP_LT                    (ltInt64#)-#define OP_LE                    (leInt64#)-#define OP_PLUS                  (plusInt64#)-#define OP_MINUS                 (minusInt64#)-#define OP_TIMES                 (timesInt64#)-#define OP_NEGATE                negateInt64#-#else-#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#-#endif-#include "Array.h"---instance Num (ArrayI64 ds) where-  (+) = zipV OP_PLUS-  {-# INLINE (+) #-}-  (-) = zipV OP_MINUS-  {-# INLINE (-) #-}-  (*) = zipV OP_TIMES-  {-# INLINE (*) #-}-  negate = mapV OP_NEGATE-  {-# INLINE negate #-}-  abs = mapV (\x -> if isTrue# (OP_GE x EL_ZERO)-                    then x-                    else OP_NEGATE x-                )-  {-# INLINE abs #-}-  signum = mapV (\x -> if isTrue# (OP_GT x EL_ZERO)-                       then EL_ONE-                       else if isTrue# (OP_LT x EL_ZERO)-                            then EL_MINUS_ONE-                            else EL_ZERO-                )-  {-# INLINE signum #-}-  fromInteger = broadcastArray . fromInteger-  {-# INLINE fromInteger #-}--instance Bounded (ArrayI64 ds) where-    minBound = broadcastArray minBound-    maxBound = broadcastArray maxBound

@@ -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

@@ -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

@@ -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

@@ -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

@@ -1,128 +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--#include "MachDeps.h"-import           GHC.Base                  (runRW#)-import           GHC.Prim-import           GHC.Types                 (Int (..), RuntimeRep (..), isTrue#)-import           GHC.Word                  (Word64 (..))-#if WORD_SIZE_IN_BITS < 64-import           GHC.IntWord64-#endif--import           Numeric.Array.ElementWise-import           Numeric.Array.Family-import           Numeric.Commons-import           Numeric.Dimensions-import           Numeric.Dimensions.Traverse--#if SIZEOF_HSWORD < 8--plusWord64#, minusWord64#, timesWord64#-  :: Word64# -> Word64# -> Word64#-plusWord64# x y  = int64ToWord64# (word64ToInt64# x `plusInt64#`  word64ToInt64# y)-minusWord64# x y = int64ToWord64# (word64ToInt64# x `minusInt64#` word64ToInt64# y)-timesWord64# x y = int64ToWord64# (word64ToInt64# x `timesInt64#` word64ToInt64# y)---#define ARR_TYPE                 ArrayW64-#define ARR_FROMSCALAR           FromScalarW64#-#define ARR_CONSTR               ArrayW64#-#define EL_TYPE_BOXED            Word64-#define EL_TYPE_PRIM             Word64#-#define EL_RUNTIME_REP           'Word64Rep-#define EL_CONSTR                W64#-#define EL_SIZE                  SIZEOF_WORD64#-#define EL_ALIGNMENT             ALIGNMENT_WORD64#-#define EL_ZERO                  (wordToWord64# 0##)-#define EL_ONE                   (wordToWord64# 1##)-#define INDEX_ARRAY              indexWord64Array#-#define WRITE_ARRAY              writeWord64Array#-#define OP_EQ                    (eqWord64#)-#define OP_NE                    (neWord64#)-#define OP_GT                    (gtWord64#)-#define OP_GE                    (geWord64#)-#define OP_LT                    (ltWord64#)-#define OP_LE                    (leWord64#)-#define OP_PLUS                  (plusWord64#)-#define OP_MINUS                 (minusWord64#)-#define OP_TIMES                 (timesWord64#)-#else-#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 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#-#endif-#include "Array.h"--instance Num (ArrayW64 ds) where-  (+) = zipV OP_PLUS-  {-# INLINE (+) #-}-  (-) = zipV OP_MINUS-  {-# INLINE (-) #-}-  (*) = zipV OP_TIMES-  {-# INLINE (*) #-}-#if SIZEOF_HSWORD < 8-  negate = mapV (\x -> int64ToWord64# (negateInt64# (word64ToInt64# x)))-#else-  negate = mapV (\x -> int2Word# (negateInt# (word2Int# x)))-#endif-  {-# INLINE negate #-}-  abs = id-  {-# INLINE abs #-}-  signum = mapV (\x -> if isTrue# (OP_GT x EL_ZERO)-                       then EL_ONE-                       else EL_ZERO-                )-  {-# INLINE signum #-}-  fromInteger = broadcastArray . fromInteger-  {-# INLINE fromInteger #-}---instance Bounded (ArrayW64 ds) where-    minBound = broadcastArray minBound-    maxBound = broadcastArray maxBound

@@ -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

@@ -1,268 +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.DoubleX2--- Copyright   :  (c) Artem Chirkin--- License     :  BSD3------ Maintainer  :  chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.DoubleX2 () where---#include "MachDeps.h"--import           GHC.Base                  (runRW#)-import           GHC.Prim-import           GHC.Types                 (Double (..), RuntimeRep (..),-                                            isTrue#)--import           Numeric.Array.ElementWise-import           Numeric.Array.Family-import           Numeric.Commons-import           Numeric.Dimensions---instance Bounded DoubleX2 where-  maxBound = case infty of D# x -> DoubleX2# x x-  minBound = case negate infty of D# x -> DoubleX2# x x--infty :: Double-infty = read "Infinity"----instance Show DoubleX2 where-  show (DoubleX2# a1 a2) = "{ "     ++ show (D# a1)-                            ++ ", " ++ show (D# a2)-                            ++ " }"----instance Eq DoubleX2 where-  DoubleX2# a1 a2 == DoubleX2# b1 b2 = isTrue# (  (a1 ==## b1)-                                          `andI#` (a2 ==## b2)-                                           )-  {-# INLINE (==) #-}-  DoubleX2# a1 a2 /= DoubleX2# b1 b2 = isTrue# (  (a1 /=## b1)-                                           `orI#` (a2 /=## b2)-                                           )-  {-# INLINE (/=) #-}------ | Implement partial ordering for `>`, `<`, `>=`, `<=`---           and lexicographical ordering for `compare`-instance Ord DoubleX2 where-  DoubleX2# a1 a2 > DoubleX2# b1 b2 = isTrue# (   (a1 >## b1)-                                          `andI#` (a2 >## b2)-                                           )-  {-# INLINE (>) #-}-  DoubleX2# a1 a2 < DoubleX2# b1 b2 = isTrue# (   (a1 <## b1)-                                          `andI#` (a2 <## b2)-                                           )-  {-# INLINE (<) #-}-  DoubleX2# a1 a2 >= DoubleX2# b1 b2 = isTrue# (  (a1 >=## b1)-                                          `andI#` (a2 >=## b2)-                                           )-  {-# INLINE (>=) #-}-  DoubleX2# a1 a2 <= DoubleX2# b1 b2 = isTrue# (  (a1 <=## b1)-                                          `andI#` (a2 <=## b2)-                                           )-  {-# INLINE (<=) #-}-  -- | Compare lexicographically-  compare (DoubleX2# a1 a2) (DoubleX2# b1 b2)-    | isTrue# (a1 >## b1) = GT-    | isTrue# (a1 <## b1) = LT-    | isTrue# (a2 >## b2) = GT-    | isTrue# (a2 <## b2) = LT-    | otherwise = EQ-  {-# INLINE compare #-}-  -- | Element-wise minimum-  min (DoubleX2# a1 a2) (DoubleX2# b1 b2) =-      DoubleX2# (if isTrue# (a1 >## b1) then b1 else a1)-                (if isTrue# (a2 >## b2) then b2 else a2)-  {-# INLINE min #-}-  -- | Element-wise maximum-  max (DoubleX2# a1 a2) (DoubleX2# b1 b2) =-      DoubleX2# (if isTrue# (a1 >## b1) then a1 else b1)-                (if isTrue# (a2 >## b2) then a2 else b2)-  {-# INLINE max #-}------ | element-wise operations for vectors-instance Num DoubleX2 where-  DoubleX2# a1 a2 + DoubleX2# b1 b2-    = DoubleX2# ((+##) a1 b1) ((+##) a2 b2)-  {-# INLINE (+) #-}-  DoubleX2# a1 a2 - DoubleX2# b1 b2-    = DoubleX2# ((-##) a1 b1) ((-##) a2 b2)-  {-# INLINE (-) #-}-  DoubleX2# a1 a2 * DoubleX2# b1 b2-    = DoubleX2# ((*##) a1 b1) ((*##) a2 b2)-  {-# INLINE (*) #-}-  negate (DoubleX2# a1 a2)-    = DoubleX2# (negateDouble# a1) (negateDouble# a2)-  {-# INLINE negate #-}-  abs (DoubleX2# a1 a2)-    = DoubleX2# (if isTrue# (a1 >=## 0.0##) then a1 else negateDouble# a1)-                (if isTrue# (a2 >=## 0.0##) then a2 else negateDouble# a2)-  {-# INLINE abs #-}-  signum (DoubleX2# a1 a2)-    = DoubleX2# (if isTrue# (a1 >## 0.0##)-                then 1.0##-                else if isTrue# (a1 <## 0.0##) then -1.0## else 0.0## )-               (if isTrue# (a2 >## 0.0##)-                then 1.0##-                else if isTrue# (a2 <## 0.0##) then -1.0## else 0.0## )-  {-# INLINE signum #-}-  fromInteger n = case fromInteger n of D# x -> DoubleX2# x x-  {-# INLINE fromInteger #-}----instance Fractional DoubleX2 where-  DoubleX2# a1 a2 / DoubleX2# b1 b2 = DoubleX2# ((/##) a1 b1)-                                                ((/##) a2 b2)-  {-# INLINE (/) #-}-  recip (DoubleX2# a1 a2) = DoubleX2# ((/##) 1.0## a1)-                                      ((/##) 1.0## a2)-  {-# INLINE recip #-}-  fromRational r = case fromRational r of D# x -> DoubleX2# x x-  {-# INLINE fromRational #-}----instance Floating DoubleX2 where-  pi = DoubleX2# 3.141592653589793238## 3.141592653589793238##-  {-# INLINE pi #-}-  exp (DoubleX2# a1 a2) = DoubleX2# (expDouble# a1)-                                    (expDouble# a2)-  {-# INLINE exp #-}-  log (DoubleX2# a1 a2) = DoubleX2# (logDouble# a1)-                                    (logDouble# a2)-  {-# INLINE log #-}-  sqrt (DoubleX2# a1 a2) = DoubleX2# (sqrtDouble# a1)-                                     (sqrtDouble# a2)-  {-# INLINE sqrt #-}-  sin (DoubleX2# a1 a2) = DoubleX2# (sinDouble# a1)-                                    (sinDouble# a2)-  {-# INLINE sin #-}-  cos (DoubleX2# a1 a2) = DoubleX2# (cosDouble# a1)-                                    (cosDouble# a2)-  {-# INLINE cos #-}-  tan (DoubleX2# a1 a2) = DoubleX2# (tanDouble# a1)-                                    (tanDouble# a2)-  {-# INLINE tan #-}-  asin (DoubleX2# a1 a2) = DoubleX2# (asinDouble# a1)-                                     (asinDouble# a2)-  {-# INLINE asin #-}-  acos (DoubleX2# a1 a2) = DoubleX2# (acosDouble# a1)-                                     (acosDouble# a2)-  {-# INLINE acos #-}-  atan (DoubleX2# a1 a2) = DoubleX2# (atanDouble# a1)-                                     (atanDouble# a2)-  {-# INLINE atan #-}-  sinh (DoubleX2# a1 a2) = DoubleX2# (sinDouble# a1)-                                     (sinDouble# a2)-  {-# INLINE sinh #-}-  cosh (DoubleX2# a1 a2) = DoubleX2# (coshDouble# a1)-                                     (coshDouble# a2)-  {-# INLINE cosh #-}-  tanh (DoubleX2# a1 a2) = DoubleX2# (tanhDouble# a1)-                                     (tanhDouble# a2)-  {-# INLINE tanh #-}-  DoubleX2# a1 a2 ** DoubleX2# b1 b2 = DoubleX2# ((**##) a1 b1)-                                                 ((**##) 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 #-}----type instance ElemRep DoubleX2 = 'DoubleRep-type instance ElemPrim DoubleX2 = Double#-instance PrimBytes DoubleX2 where-  toBytes (DoubleX2# a1 a2) = case runRW#-     ( \s0 -> case newByteArray# (SIZEOF_HSDOUBLE# *# 2#) s0 of-         (# s1, marr #) -> case writeDoubleArray# marr 0# a1 s1 of-           s2 -> case writeDoubleArray# marr 1# a2 s2 of-             s3 -> unsafeFreezeByteArray# marr s3-     ) of (# _, a #) -> (# 0#, 2#, a #)-  {-# INLINE toBytes #-}-  fromBytes (# off, _, arr #) = DoubleX2#-    (indexDoubleArray# arr off)-    (indexDoubleArray# arr (off +# 1#))-  {-# INLINE fromBytes #-}-  byteSize _ = SIZEOF_HSDOUBLE# *# 2#-  {-# INLINE byteSize #-}-  byteAlign _ = ALIGNMENT_HSDOUBLE#-  {-# INLINE byteAlign #-}-  elementByteSize _ = SIZEOF_HSDOUBLE#-  {-# INLINE elementByteSize #-}-  ix 0# (DoubleX2# a1 _) = a1-  ix 1# (DoubleX2# _ a2) = a2-  ix _ _                = undefined-  {-# INLINE ix #-}---instance ElementWise (Idx '[2]) Double DoubleX2 where-  indexOffset# (DoubleX2# a1 _) 0# = D# a1-  indexOffset# (DoubleX2# _ a2) 1# = D# a2-  indexOffset# _               _  = undefined-  {-# INLINE indexOffset# #-}--  (!) (DoubleX2# a1 _) ( 1 :! Z) = D# a1-  (!) (DoubleX2# _ a2) ( 2 :! Z) = D# a2-  (!) _               ( _ :! Z) = undefined-  {-# INLINE (!) #-}--  broadcast (D# x) = DoubleX2# x x-  {-# INLINE broadcast #-}--  ewmap f (DoubleX2# x y) = case (f (1:!Z) (D# x), f (2:!Z) (D# y)) of-                              (D# r1, D# r2) -> DoubleX2# r1 r2-  {-# INLINE ewmap #-}--  ewgen f = case (f (1:!Z), f (2:!Z)) of (D# r1, D# r2) -> DoubleX2# r1 r2-  {-# INLINE ewgen #-}--  ewgenA f = (\(D# r1) (D# r2) -> DoubleX2# r1 r2) <$> f (1:!Z) <*> f (2:!Z)-  {-# INLINE ewgenA #-}--  ewfoldl f x0 (DoubleX2# x y) = f (2:!Z) (f (1:!Z) x0 (D# x)) (D# y)-  {-# INLINE ewfoldl #-}--  ewfoldr f x0 (DoubleX2# x y) = f (1:!Z) (D# x) (f (2:!Z) (D# y) x0)-  {-# INLINE ewfoldr #-}--  elementWise f (DoubleX2# x y) = (\(D# a) (D# b) -> DoubleX2# a b)-                               <$> f (D# x) <*> f (D# y)-  {-# INLINE elementWise #-}--  indexWise f (DoubleX2# x y) = (\(D# a) (D# b) -> DoubleX2# a b)-                             <$> f (1:!Z) (D# x) <*> f (2:!Z) (D# y)-  {-# INLINE indexWise #-}--  update (1 :! Z) (D# q) (DoubleX2# _ y) = DoubleX2# q y-  update (2 :! Z) (D# q) (DoubleX2# x _) = DoubleX2# x q-  update (_ :! Z) _ x = x-  {-# INLINE update #-}

@@ -1,304 +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.DoubleX3--- Copyright   :  (c) Artem Chirkin--- License     :  BSD3------ Maintainer  :  chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.DoubleX3 () where---#include "MachDeps.h"--import           GHC.Base                  (runRW#)-import           GHC.Prim-import           GHC.Types                 (Double (..), RuntimeRep (..),-                                            isTrue#)--import           Numeric.Array.ElementWise-import           Numeric.Array.Family-import           Numeric.Commons-import           Numeric.Dimensions---instance Bounded DoubleX3 where-  maxBound = case infty of D# x -> DoubleX3# x x x-  minBound = case negate infty of D# x -> DoubleX3# x x x--infty :: Double-infty = read "Infinity"---instance Show DoubleX3 where-  show (DoubleX3# a1 a2 a3) = "{ "     ++ show (D# a1)-                              ++ ", " ++ show (D# a2)-                              ++ ", " ++ show (D# a3)-                              ++ " }"----instance Eq DoubleX3 where-  DoubleX3# a1 a2 a3 == DoubleX3# b1 b2 b3 = isTrue# (  (a1 ==## b1)-                                              `andI#` (a2 ==## b2)-                                              `andI#` (a3 ==## b3)-                                              )-  {-# INLINE (==) #-}-  DoubleX3# a1 a2 a3 /= DoubleX3# b1 b2 b3 = isTrue# (  (a1 /=## b1)-                                               `orI#` (a2 /=## b2)-                                               `orI#` (a3 /=## b3)-                                               )-  {-# INLINE (/=) #-}------ | Implement partial ordering for `>`, `<`, `>=`, `<=`---           and lexicographical ordering for `compare`-instance Ord DoubleX3 where-  DoubleX3# a1 a2 a3 > DoubleX3# b1 b2 b3 = isTrue# (   (a1 >## b1)-                                              `andI#` (a2 >## b2)-                                              `andI#` (a3 >## b3)-                                              )-  {-# INLINE (>) #-}-  DoubleX3# a1 a2 a3 < DoubleX3# b1 b2 b3 = isTrue# (   (a1 <## b1)-                                              `andI#` (a2 <## b2)-                                              `andI#` (a3 <## b3)-                                              )-  {-# INLINE (<) #-}-  DoubleX3# a1 a2 a3 >= DoubleX3# b1 b2 b3 = isTrue# (  (a1 >=## b1)-                                              `andI#` (a2 >=## b2)-                                              `andI#` (a3 >=## b3)-                                              )-  {-# INLINE (>=) #-}-  DoubleX3# a1 a2 a3 <= DoubleX3# b1 b2 b3 = isTrue# (  (a1 <=## b1)-                                              `andI#` (a2 <=## b2)-                                              `andI#` (a3 <=## b3)-                                              )-  {-# INLINE (<=) #-}-  -- | Compare lexicographically-  compare (DoubleX3# a1 a2 a3) (DoubleX3# b1 b2 b3)-    | isTrue# (a1 >## b1) = GT-    | isTrue# (a1 <## b1) = LT-    | isTrue# (a2 >## b2) = GT-    | isTrue# (a2 <## b2) = LT-    | isTrue# (a3 >## b3) = GT-    | isTrue# (a3 <## b3) = LT-    | otherwise = EQ-  {-# INLINE compare #-}-  -- | Element-wise minimum-  min (DoubleX3# a1 a2 a3) (DoubleX3# b1 b2 b3) =-      DoubleX3# (if isTrue# (a1 >## b1) then b1 else a1)-               (if isTrue# (a2 >## b2) then b2 else a2)-               (if isTrue# (a3 >## b3) then b3 else a3)-  {-# INLINE min #-}-  -- | Element-wise maximum-  max (DoubleX3# a1 a2 a3) (DoubleX3# b1 b2 b3) =-      DoubleX3# (if isTrue# (a1 >## b1) then a1 else b1)-               (if isTrue# (a2 >## b2) then a2 else b2)-               (if isTrue# (a3 >## b3) then a3 else b3)-  {-# INLINE max #-}------ | element-wise operations for vectors-instance Num DoubleX3 where-  DoubleX3# a1 a2 a3 + DoubleX3# b1 b2 b3-    = DoubleX3# ((+##) a1 b1) ((+##) a2 b2) ((+##) a3 b3)-  {-# INLINE (+) #-}-  DoubleX3# a1 a2 a3 - DoubleX3# b1 b2 b3-    = DoubleX3# ((-##) a1 b1) ((-##) a2 b2) ((-##) a3 b3)-  {-# INLINE (-) #-}-  DoubleX3# a1 a2 a3 * DoubleX3# b1 b2 b3-    = DoubleX3# ((*##) a1 b1) ((*##) a2 b2) ((*##) a3 b3)-  {-# INLINE (*) #-}-  negate (DoubleX3# a1 a2 a3)-    = DoubleX3# (negateDouble# a1) (negateDouble# a2) (negateDouble# a3)-  {-# INLINE negate #-}-  abs (DoubleX3# a1 a2 a3)-    = DoubleX3# (if isTrue# (a1 >=## 0.0##) then a1 else negateDouble# a1)-               (if isTrue# (a2 >=## 0.0##) then a2 else negateDouble# a2)-               (if isTrue# (a3 >=## 0.0##) then a3 else negateDouble# a3)-  {-# INLINE abs #-}-  signum (DoubleX3# a1 a2 a3)-    = DoubleX3# (if isTrue# (a1 >## 0.0##)-                then 1.0##-                else if isTrue# (a1 <## 0.0##) then -1.0## else 0.0## )-               (if isTrue# (a2 >## 0.0##)-                then 1.0##-                else if isTrue# (a2 <## 0.0##) then -1.0## else 0.0## )-               (if isTrue# (a3 >## 0.0##)-                then 1.0##-                else if isTrue# (a3 <## 0.0##) then -1.0## else 0.0## )-  {-# INLINE signum #-}-  fromInteger n = case fromInteger n of D# x -> DoubleX3# x x x-  {-# INLINE fromInteger #-}----instance Fractional DoubleX3 where-  DoubleX3# a1 a2 a3 / DoubleX3# b1 b2 b3  = DoubleX3# ((/##) a1 b1)-                                                    ((/##) a2 b2)-                                                    ((/##) a3 b3)-  {-# INLINE (/) #-}-  recip (DoubleX3# a1 a2 a3) = DoubleX3# ((/##) 1.0## a1)-                                       ((/##) 1.0## a2)-                                       ((/##) 1.0## a3)-  {-# INLINE recip #-}-  fromRational r = case fromRational r of D# x -> DoubleX3# x x x-  {-# INLINE fromRational #-}----instance Floating DoubleX3 where-  pi = DoubleX3# 3.141592653589793238## 3.141592653589793238## 3.141592653589793238##-  {-# INLINE pi #-}-  exp (DoubleX3# a1 a2 a3) = DoubleX3# (expDouble# a1)-                                     (expDouble# a2)-                                     (expDouble# a3)-  {-# INLINE exp #-}-  log (DoubleX3# a1 a2 a3) = DoubleX3# (logDouble# a1)-                                     (logDouble# a2)-                                     (logDouble# a3)-  {-# INLINE log #-}-  sqrt (DoubleX3# a1 a2 a3) = DoubleX3# (sqrtDouble# a1)-                                      (sqrtDouble# a2)-                                      (sqrtDouble# a3)-  {-# INLINE sqrt #-}-  sin (DoubleX3# a1 a2 a3) = DoubleX3# (sinDouble# a1)-                                     (sinDouble# a2)-                                     (sinDouble# a3)-  {-# INLINE sin #-}-  cos (DoubleX3# a1 a2 a3) = DoubleX3# (cosDouble# a1)-                                     (cosDouble# a2)-                                     (cosDouble# a3)-  {-# INLINE cos #-}-  tan (DoubleX3# a1 a2 a3) = DoubleX3# (tanDouble# a1)-                                     (tanDouble# a2)-                                     (tanDouble# a3)-  {-# INLINE tan #-}-  asin (DoubleX3# a1 a2 a3) = DoubleX3# (asinDouble# a1)-                                      (asinDouble# a2)-                                      (asinDouble# a3)-  {-# INLINE asin #-}-  acos (DoubleX3# a1 a2 a3) = DoubleX3# (acosDouble# a1)-                                      (acosDouble# a2)-                                      (acosDouble# a3)-  {-# INLINE acos #-}-  atan (DoubleX3# a1 a2 a3) = DoubleX3# (atanDouble# a1)-                                      (atanDouble# a2)-                                      (atanDouble# a3)-  {-# INLINE atan #-}-  sinh (DoubleX3# a1 a2 a3) = DoubleX3# (sinDouble# a1)-                                      (sinDouble# a2)-                                      (sinDouble# a3)-  {-# INLINE sinh #-}-  cosh (DoubleX3# a1 a2 a3) = DoubleX3# (coshDouble# a1)-                                      (coshDouble# a2)-                                      (coshDouble# a3)-  {-# INLINE cosh #-}-  tanh (DoubleX3# a1 a2 a3) = DoubleX3# (tanhDouble# a1)-                                      (tanhDouble# a2)-                                      (tanhDouble# a3)-  {-# INLINE tanh #-}-  DoubleX3# a1 a2 a3 ** DoubleX3# b1 b2 b3 = DoubleX3# ((**##) a1 b1)-                                                    ((**##) a2 b2)-                                                    ((**##) 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 DoubleX3 = 'DoubleRep-type instance ElemPrim DoubleX3 = Double#-instance PrimBytes DoubleX3 where-  toBytes (DoubleX3# a1 a2 a3) = case runRW#-     ( \s0 -> case newByteArray# (SIZEOF_HSDOUBLE# *# 3#) s0 of-         (# s1, marr #) -> case writeDoubleArray# marr 0# a1 s1 of-           s2 -> case writeDoubleArray# marr 1# a2 s2 of-             s3 -> case writeDoubleArray# marr 2# a3 s3 of-               s4 -> unsafeFreezeByteArray# marr s4-     ) of (# _, a #) -> (# 0#, 3#, a #)-  {-# INLINE toBytes #-}-  fromBytes (# off, _, arr #) = DoubleX3#-    (indexDoubleArray# arr off)-    (indexDoubleArray# arr (off +# 1#))-    (indexDoubleArray# arr (off +# 2#))-  {-# INLINE fromBytes #-}-  byteSize _ = SIZEOF_HSDOUBLE# *# 3#-  {-# INLINE byteSize #-}-  byteAlign _ = ALIGNMENT_HSDOUBLE#-  {-# INLINE byteAlign #-}-  elementByteSize _ = SIZEOF_HSDOUBLE#-  {-# INLINE elementByteSize #-}-  ix 0# (DoubleX3# a1 _ _) = a1-  ix 1# (DoubleX3# _ a2 _) = a2-  ix 2# (DoubleX3# _ _ a3) = a3-  ix _ _                  = undefined-  {-# INLINE ix #-}---instance ElementWise (Idx '[3]) Double DoubleX3 where-  indexOffset# (DoubleX3# a1 _ _) 0# = D# a1-  indexOffset# (DoubleX3# _ a2 _) 1# = D# a2-  indexOffset# (DoubleX3# _ _ a3) 2# = D# a3-  indexOffset# _                   _  = undefined-  {-# INLINE indexOffset# #-}--  (!) (DoubleX3# a1 _ _) ( 1 :! Z) = D# a1-  (!) (DoubleX3# _ a2 _) ( 2 :! Z) = D# a2-  (!) (DoubleX3# _ _ a3) ( 3 :! Z) = D# a3-  (!) _               ( _ :! Z)   = undefined-  {-# INLINE (!) #-}--  broadcast (D# x) = DoubleX3# x x x-  {-# INLINE broadcast #-}--  ewmap f (DoubleX3# x y z) = case (f (1:!Z) (D# x), f (2:!Z) (D# y), f (3:!Z) (D# z)) of-                              (D# r1, D# r2, D# r3) -> DoubleX3# r1 r2 r3-  {-# INLINE ewmap #-}--  ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z)) of (D# r1, D# r2, D# r3) -> DoubleX3# r1 r2 r3-  {-# INLINE ewgen #-}--  ewgenA f = (\(D# r1) (D# r2) (D# r3) -> DoubleX3# r1 r2 r3)-          <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z)-  {-# INLINE ewgenA #-}--  ewfoldl f x0 (DoubleX3# x y z) = f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (D# x)) (D# y)) (D# z)-  {-# INLINE ewfoldl #-}--  ewfoldr f x0 (DoubleX3# x y z) = f (1:!Z) (D# x) (f (2:!Z) (D# y) (f (3:!Z) (D# z) x0))-  {-# INLINE ewfoldr #-}--  elementWise f (DoubleX3# x y z) = (\(D# a) (D# b) (D# c) -> DoubleX3# a b c)-                                 <$> f (D# x) <*> f (D# y) <*> f (D# z)-  {-# INLINE elementWise #-}--  indexWise f (DoubleX3# x y z) = (\(D# a) (D# b) (D# c) -> DoubleX3# a b c)-                             <$> f (1:!Z) (D# x) <*> f (2:!Z) (D# y) <*> f (3:!Z) (D# z)-  {-# INLINE indexWise #-}--  update (1 :! Z) (D# q) (DoubleX3# _ y z) = DoubleX3# q y z-  update (2 :! Z) (D# q) (DoubleX3# x _ z) = DoubleX3# x q z-  update (3 :! Z) (D# q) (DoubleX3# x y _) = DoubleX3# x y q-  update (_ :! Z) _ x = x-  {-# INLINE update #-}

@@ -1,340 +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.DoubleX4--- Copyright   :  (c) Artem Chirkin--- License     :  BSD3------ Maintainer  :  chirkin@arch.ethz.ch--------------------------------------------------------------------------------------module Numeric.Array.Family.DoubleX4 () where---#include "MachDeps.h"--import           GHC.Base                  (runRW#)-import           GHC.Prim-import           GHC.Types                 (Double (..), RuntimeRep (..),-                                            isTrue#)--import           Numeric.Array.ElementWise-import           Numeric.Array.Family-import           Numeric.Commons-import           Numeric.Dimensions---instance Bounded DoubleX4 where-  maxBound = case infty of D# x -> DoubleX4# x x x x-  minBound = case negate infty of D# x -> DoubleX4# x x x x--infty :: Double-infty = read "Infinity"---instance Show DoubleX4 where-  show (DoubleX4# a1 a2 a3 a4) = "{ "     ++ show (D# a1)-                              ++ ", " ++ show (D# a2)-                              ++ ", " ++ show (D# a3)-                              ++ ", " ++ show (D# a4)-                              ++ " }"----instance Eq DoubleX4 where-  DoubleX4# a1 a2 a3 a4 == DoubleX4# b1 b2 b3 b4 = isTrue# (  (a1 ==## b1)-                                              `andI#` (a2 ==## b2)-                                              `andI#` (a3 ==## b3)-                                              `andI#` (a4 ==## b4)-                                              )-  {-# INLINE (==) #-}-  DoubleX4# a1 a2 a3 a4 /= DoubleX4# b1 b2 b3 b4 = isTrue# (  (a1 /=## b1)-                                               `orI#` (a2 /=## b2)-                                               `orI#` (a3 /=## b3)-                                               `orI#` (a4 /=## b4)-                                               )-  {-# INLINE (/=) #-}------ | Implement partial ordering for `>`, `<`, `>=`, `<=`---           and lexicographical ordering for `compare`-instance Ord DoubleX4 where-  DoubleX4# a1 a2 a3 a4 > DoubleX4# b1 b2 b3 b4 = isTrue# (   (a1 >## b1)-                                              `andI#` (a2 >## b2)-                                              `andI#` (a3 >## b3)-                                              `andI#` (a4 >## b4)-                                              )-  {-# INLINE (>) #-}-  DoubleX4# a1 a2 a3 a4 < DoubleX4# b1 b2 b3 b4 = isTrue# (   (a1 <## b1)-                                              `andI#` (a2 <## b2)-                                              `andI#` (a3 <## b3)-                                              `andI#` (a4 <## b4)-                                              )-  {-# INLINE (<) #-}-  DoubleX4# a1 a2 a3 a4 >= DoubleX4# b1 b2 b3 b4 = isTrue# (  (a1 >=## b1)-                                              `andI#` (a2 >=## b2)-                                              `andI#` (a3 >=## b3)-                                              `andI#` (a4 >=## b4)-                                              )-  {-# INLINE (>=) #-}-  DoubleX4# a1 a2 a3 a4 <= DoubleX4# b1 b2 b3 b4 = isTrue# (  (a1 <=## b1)-                                              `andI#` (a2 <=## b2)-                                              `andI#` (a3 <=## b3)-                                              `andI#` (a4 <=## b4)-                                              )-  {-# INLINE (<=) #-}-  -- | Compare lexicographically-  compare (DoubleX4# a1 a2 a3 a4) (DoubleX4# b1 b2 b3 b4)-    | isTrue# (a1 >## b1) = GT-    | isTrue# (a1 <## b1) = LT-    | isTrue# (a2 >## b2) = GT-    | isTrue# (a2 <## b2) = LT-    | isTrue# (a3 >## b3) = GT-    | isTrue# (a3 <## b3) = LT-    | isTrue# (a4 >## b4) = GT-    | isTrue# (a4 <## b4) = LT-    | otherwise = EQ-  {-# INLINE compare #-}-  -- | Element-wise minimum-  min (DoubleX4# a1 a2 a3 a4) (DoubleX4# b1 b2 b3 b4) =-      DoubleX4# (if isTrue# (a1 >## b1) then b1 else a1)-               (if isTrue# (a2 >## b2) then b2 else a2)-               (if isTrue# (a3 >## b3) then b3 else a3)-               (if isTrue# (a4 >## b4) then b4 else a4)-  {-# INLINE min #-}-  -- | Element-wise maximum-  max (DoubleX4# a1 a2 a3 a4) (DoubleX4# b1 b2 b3 b4) =-      DoubleX4# (if isTrue# (a1 >## b1) then a1 else b1)-               (if isTrue# (a2 >## b2) then a2 else b2)-               (if isTrue# (a3 >## b3) then a3 else b3)-               (if isTrue# (a4 >## b4) then a4 else b4)-  {-# INLINE max #-}------ | element-wise operations for vectors-instance Num DoubleX4 where-  DoubleX4# a1 a2 a3 a4 + DoubleX4# b1 b2 b3 b4-    = DoubleX4# ((+##) a1 b1) ((+##) a2 b2) ((+##) a3 b3) ((+##) a4 b4)-  {-# INLINE (+) #-}-  DoubleX4# a1 a2 a3 a4 - DoubleX4# b1 b2 b3 b4-    = DoubleX4# ((-##) a1 b1) ((-##) a2 b2) ((-##) a3 b3) ((-##) a4 b4)-  {-# INLINE (-) #-}-  DoubleX4# a1 a2 a3 a4 * DoubleX4# b1 b2 b3 b4-    = DoubleX4# ((*##) a1 b1) ((*##) a2 b2) ((*##) a3 b3) ((*##) a4 b4)-  {-# INLINE (*) #-}-  negate (DoubleX4# a1 a2 a3 a4)-    = DoubleX4# (negateDouble# a1) (negateDouble# a2) (negateDouble# a3) (negateDouble# a4)-  {-# INLINE negate #-}-  abs (DoubleX4# a1 a2 a3 a4)-    = DoubleX4# (if isTrue# (a1 >=## 0.0##) then a1 else negateDouble# a1)-               (if isTrue# (a2 >=## 0.0##) then a2 else negateDouble# a2)-               (if isTrue# (a3 >=## 0.0##) then a3 else negateDouble# a3)-               (if isTrue# (a4 >=## 0.0##) then a4 else negateDouble# a4)-  {-# INLINE abs #-}-  signum (DoubleX4# a1 a2 a3 a4)-    = DoubleX4# (if isTrue# (a1 >## 0.0##)-                then 1.0##-                else if isTrue# (a1 <## 0.0##) then -1.0## else 0.0## )-               (if isTrue# (a2 >## 0.0##)-                then 1.0##-                else if isTrue# (a2 <## 0.0##) then -1.0## else 0.0## )-               (if isTrue# (a3 >## 0.0##)-                then 1.0##-                else if isTrue# (a3 <## 0.0##) then -1.0## else 0.0## )-               (if isTrue# (a4 >## 0.0##)-                then 1.0##-                else if isTrue# (a4 <## 0.0##) then -1.0## else 0.0## )-  {-# INLINE signum #-}-  fromInteger n = case fromInteger n of D# x -> DoubleX4# x x x x-  {-# INLINE fromInteger #-}----instance Fractional DoubleX4 where-  DoubleX4# a1 a2 a3 a4 / DoubleX4# b1 b2 b3 b4  = DoubleX4# ((/##) a1 b1)-                                                    ((/##) a2 b2)-                                                    ((/##) a3 b3)-                                                    ((/##) a4 b4)-  {-# INLINE (/) #-}-  recip (DoubleX4# a1 a2 a3 a4) = DoubleX4# ((/##) 1.0## a1)-                                       ((/##) 1.0## a2)-                                       ((/##) 1.0## a3)-                                       ((/##) 1.0## a4)-  {-# INLINE recip #-}-  fromRational r = case fromRational r of D# x -> DoubleX4# x x x x-  {-# INLINE fromRational #-}----instance Floating DoubleX4 where-  pi = DoubleX4# 3.141592653589793238## 3.141592653589793238## 3.141592653589793238## 3.141592653589793238##-  {-# INLINE pi #-}-  exp (DoubleX4# a1 a2 a3 a4) = DoubleX4# (expDouble# a1)-                                     (expDouble# a2)-                                     (expDouble# a3)-                                     (expDouble# a4)-  {-# INLINE exp #-}-  log (DoubleX4# a1 a2 a3 a4) = DoubleX4# (logDouble# a1)-                                     (logDouble# a2)-                                     (logDouble# a3)-                                     (logDouble# a4)-  {-# INLINE log #-}-  sqrt (DoubleX4# a1 a2 a3 a4) = DoubleX4# (sqrtDouble# a1)-                                      (sqrtDouble# a2)-                                      (sqrtDouble# a3)-                                      (sqrtDouble# a4)-  {-# INLINE sqrt #-}-  sin (DoubleX4# a1 a2 a3 a4) = DoubleX4# (sinDouble# a1)-                                     (sinDouble# a2)-                                     (sinDouble# a3)-                                     (sinDouble# a4)-  {-# INLINE sin #-}-  cos (DoubleX4# a1 a2 a3 a4) = DoubleX4# (cosDouble# a1)-                                     (cosDouble# a2)-                                     (cosDouble# a3)-                                     (cosDouble# a4)-  {-# INLINE cos #-}-  tan (DoubleX4# a1 a2 a3 a4) = DoubleX4# (tanDouble# a1)-                                     (tanDouble# a2)-                                     (tanDouble# a3)-                                     (tanDouble# a4)-  {-# INLINE tan #-}-  asin (DoubleX4# a1 a2 a3 a4) = DoubleX4# (asinDouble# a1)-                                      (asinDouble# a2)-                                      (asinDouble# a3)-                                      (asinDouble# a4)-  {-# INLINE asin #-}-  acos (DoubleX4# a1 a2 a3 a4) = DoubleX4# (acosDouble# a1)-                                      (acosDouble# a2)-                                      (acosDouble# a3)-                                      (acosDouble# a4)-  {-# INLINE acos #-}-  atan (DoubleX4# a1 a2 a3 a4) = DoubleX4# (atanDouble# a1)-                                      (atanDouble# a2)-                                      (atanDouble# a3)-                                      (atanDouble# a4)-  {-# INLINE atan #-}-  sinh (DoubleX4# a1 a2 a3 a4) = DoubleX4# (sinDouble# a1)-                                      (sinDouble# a2)-                                      (sinDouble# a3)-                                      (sinDouble# a4)-  {-# INLINE sinh #-}-  cosh (DoubleX4# a1 a2 a3 a4) = DoubleX4# (coshDouble# a1)-                                      (coshDouble# a2)-                                      (coshDouble# a3)-                                      (coshDouble# a4)-  {-# INLINE cosh #-}-  tanh (DoubleX4# a1 a2 a3 a4) = DoubleX4# (tanhDouble# a1)-                                      (tanhDouble# a2)-                                      (tanhDouble# a3)-                                      (tanhDouble# a4)-  {-# INLINE tanh #-}-  DoubleX4# a1 a2 a3 a4 ** DoubleX4# b1 b2 b3 b4 = DoubleX4# ((**##) a1 b1)-                                                    ((**##) a2 b2)-                                                    ((**##) a3 b3)-                                                    ((**##) 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 DoubleX4 = 'DoubleRep-type instance ElemPrim DoubleX4 = Double#-instance PrimBytes DoubleX4 where-  toBytes (DoubleX4# a1 a2 a3 a4) = case runRW#-     ( \s0 -> case newByteArray# (SIZEOF_HSDOUBLE# *# 3#) s0 of-         (# s1, marr #) -> case writeDoubleArray# marr 0# a1 s1 of-           s2 -> case writeDoubleArray# marr 1# a2 s2 of-             s3 -> case writeDoubleArray# marr 2# a3 s3 of-               s4 -> case writeDoubleArray# marr 3# a4 s4 of-                 s5 -> unsafeFreezeByteArray# marr s5-     ) of (# _, a #) -> (# 0#, 4#, a #)-  {-# INLINE toBytes #-}-  fromBytes (# off, _, arr #) = DoubleX4#-    (indexDoubleArray# arr off)-    (indexDoubleArray# arr (off +# 1#))-    (indexDoubleArray# arr (off +# 2#))-    (indexDoubleArray# arr (off +# 3#))-  {-# INLINE fromBytes #-}-  byteSize _ = SIZEOF_HSDOUBLE# *# 4#-  {-# INLINE byteSize #-}-  byteAlign _ = ALIGNMENT_HSDOUBLE#-  {-# INLINE byteAlign #-}-  elementByteSize _ = SIZEOF_HSDOUBLE#-  {-# INLINE elementByteSize #-}-  ix 0# (DoubleX4# a1 _ _ _) = a1-  ix 1# (DoubleX4# _ a2 _ _) = a2-  ix 2# (DoubleX4# _ _ a3 _) = a3-  ix 3# (DoubleX4# _ _ _ a4) = a4-  ix _ _                    = undefined-  {-# INLINE ix #-}---instance ElementWise (Idx '[4]) Double DoubleX4 where-  indexOffset# (DoubleX4# a1 _ _ _) 0# = D# a1-  indexOffset# (DoubleX4# _ a2 _ _) 1# = D# a2-  indexOffset# (DoubleX4# _ _ a3 _) 2# = D# a3-  indexOffset# (DoubleX4# _ _ _ a4) 3# = D# a4-  indexOffset# _                   _  = undefined-  {-# INLINE indexOffset# #-}--  (!) (DoubleX4# a1 _ _ _) ( 1 :! Z) = D# a1-  (!) (DoubleX4# _ a2 _ _) ( 2 :! Z) = D# a2-  (!) (DoubleX4# _ _ a3 _) ( 3 :! Z) = D# a3-  (!) (DoubleX4# _ _ _ a4) ( 4 :! Z) = D# a4-  (!) _                   ( _ :! Z) = undefined-  {-# INLINE (!) #-}--  broadcast (D# x) = DoubleX4# x x x x-  {-# INLINE broadcast #-}--  ewmap f (DoubleX4# x y z w) = case (f (1:!Z) (D# x), f (2:!Z) (D# y), f (3:!Z) (D# z), f (3:!Z) (D# w)) of-                              (D# r1, D# r2, D# r3, D# r4) -> DoubleX4# r1 r2 r3 r4-  {-# INLINE ewmap #-}--  ewgen f = case (f (1:!Z), f (2:!Z), f (3:!Z), f (4:!Z)) of (D# r1, D# r2, D# r3, D# r4) -> DoubleX4# r1 r2 r3 r4-  {-# INLINE ewgen #-}--  ewgenA f = (\(D# a) (D# b) (D# c) (D# d) -> DoubleX4# a b c d)-          <$> f (1:!Z) <*> f (2:!Z) <*> f (3:!Z) <*> f (4:!Z)-  {-# INLINE ewgenA #-}--  ewfoldl f x0 (DoubleX4# x y z w) = f (4:!Z) (f (3:!Z) (f (2:!Z) (f (1:!Z) x0 (D# x)) (D# y)) (D# z)) (D# w)-  {-# INLINE ewfoldl #-}--  ewfoldr f x0 (DoubleX4# x y z w) = f (1:!Z) (D# x) (f (2:!Z) (D# y) (f (3:!Z) (D# z) (f (4:!Z) (D# w) x0)))-  {-# INLINE ewfoldr #-}--  elementWise f (DoubleX4# x y z w) = (\(D# a) (D# b) (D# c) (D# d) -> DoubleX4# a b c d)-                                 <$> f (D# x) <*> f (D# y) <*> f (D# z) <*> f (D# w)-  {-# INLINE elementWise #-}--  indexWise f (DoubleX4# x y z w) = (\(D# a) (D# b) (D# c) (D# d) -> DoubleX4# a b c d)-                             <$> f (1:!Z) (D# x) <*> f (2:!Z) (D# y) <*> f (3:!Z) (D# z) <*> f (4:!Z) (D# w)-  {-# INLINE indexWise #-}--  update (1 :! Z) (D# q) (DoubleX4# _ y z w) = DoubleX4# q y z w-  update (2 :! Z) (D# q) (DoubleX4# x _ z w) = DoubleX4# x q z w-  update (3 :! Z) (D# q) (DoubleX4# x y _ w) = DoubleX4# x y q w-  update (4 :! Z) (D# q) (DoubleX4# x y z _) = DoubleX4# x y z q-  update (_ :! Z) _ x = x-  {-# INLINE update #-}

@@ -1,330 +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 Bounded FloatX2 where-  maxBound = case infty of F# x -> FloatX2# x x-  minBound = case negate infty of F# x -> FloatX2# x x--infty :: Float-infty = read "Infinity"---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 #-}

@@ -1,304 +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 Bounded FloatX3 where-  maxBound = case infty of F# x -> FloatX3# x x x-  minBound = case negate infty of F# x -> FloatX3# x x x--infty :: Float-infty = read "Infinity"----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 #-}

@@ -1,340 +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 Bounded FloatX4 where-  maxBound = case infty of F# x -> FloatX4# x x x x-  minBound = case negate infty of F# x -> FloatX4# x x x x--infty :: Float-infty = read "Infinity"---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 #-}

@@ -1,576 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# 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--#include "MachDeps.h"--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)-#if WORD_SIZE_IN_BITS < 64-        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int64 (m : bs) ) :~: 'Int64Rep-        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (m : bs) ) :~:  Int64#-        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Int64 (as +: m)) :~: 'Int64Rep-        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Int64 (as +: m)) :~:  Int64#-#else-        , 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#-#endif-        = 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)-#if WORD_SIZE_IN_BITS < 64-        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word64 (m : bs) ) :~: 'Word64Rep-        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (m : bs) ) :~:  Word64#-        , Refl <- unsafeCoerce Refl :: ElemRep  (Array Word64 (as +: m)) :~: 'Word64Rep-        , Refl <- unsafeCoerce Refl :: ElemPrim (Array Word64 (as +: m)) :~:  Word64#-#else-        , 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#-#endif-        = prodW64 n m k x y-      where-        getM :: forall m p . p (m ': bs) -> Proxy m-        getM _ = Proxy---prodF :: (PrimBytes a, PrimBytes b, PrimBytes c-         , ElemPrim a ~ Float#, ElemRep a ~ 'FloatRep-         , ElemPrim b ~ Float#, ElemRep b ~ 'FloatRep-         ) => 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 :: (PrimBytes a, PrimBytes b, PrimBytes c-         , ElemPrim a ~ Double#, ElemRep a ~ 'DoubleRep-         , ElemPrim b ~ Double#, ElemRep b ~ 'DoubleRep-         ) => 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 :: (PrimBytes a, PrimBytes b, PrimBytes c-         , ElemPrim a ~ Int#, ElemRep a ~ 'IntRep-         , ElemPrim b ~ Int#, ElemRep b ~ 'IntRep-         ) => 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 :: (PrimBytes a, PrimBytes b, PrimBytes c-         , ElemPrim a ~ Int#, ElemRep a ~ 'IntRep-         , ElemPrim b ~ Int#, ElemRep b ~ 'IntRep-         ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-           , ElemPrim a ~ Int#, ElemRep a ~ 'IntRep-           , ElemPrim b ~ Int#, ElemRep b ~ 'IntRep-           ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-           , ElemPrim a ~ Int#, ElemRep a ~ 'IntRep-           , ElemPrim b ~ Int#, ElemRep b ~ 'IntRep-           ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-#if WORD_SIZE_IN_BITS < 64-           , ElemPrim a ~ Int64#, ElemRep a ~ 'Int64Rep-           , ElemPrim b ~ Int64#, ElemRep b ~ 'Int64Rep-#else-           , ElemPrim a ~ Int#, ElemRep a ~ 'IntRep-           , ElemPrim b ~ Int#, ElemRep b ~ 'IntRep-#endif-           ) => Int# -> Int# -> Int# -> a -> b -> c-#if WORD_SIZE_IN_BITS < 64-prodI64 = undefined-#else-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 #-}-#endif--prodW :: ( PrimBytes a, PrimBytes b, PrimBytes c-         , ElemPrim a ~ Word#, ElemRep a ~ 'WordRep-         , ElemPrim b ~ Word#, ElemRep b ~ 'WordRep-         ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-          , ElemPrim a ~ Word#, ElemRep a ~ 'WordRep-          , ElemPrim b ~ Word#, ElemRep b ~ 'WordRep-          ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-           , ElemPrim a ~ Word#, ElemRep a ~ 'WordRep-           , ElemPrim b ~ Word#, ElemRep b ~ 'WordRep-           ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-           , ElemPrim a ~ Word#, ElemRep a ~ 'WordRep-           , ElemPrim b ~ Word#, ElemRep b ~ 'WordRep-           ) => 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 :: ( PrimBytes a, PrimBytes b, PrimBytes c-#if WORD_SIZE_IN_BITS < 64-           , ElemPrim a ~ Word64#, ElemRep a ~ 'Word64Rep-           , ElemPrim b ~ Word64#, ElemRep b ~ 'Word64Rep-#else-           , ElemPrim a ~ Word#, ElemRep a ~ 'WordRep-           , ElemPrim b ~ Word#, ElemRep b ~ 'WordRep-#endif-           ) => Int# -> Int# -> Int# -> a -> b -> c-#if WORD_SIZE_IN_BITS < 64-prodW64 = undefined-#else-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 #-}-#endif---- | 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# #-}

@@ -1,150 +0,0 @@-{-# 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-      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-    AIDoubleX2 -> Evidence-    AIDoubleX3 -> Evidence-    AIDoubleX4 -> 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-    AIDoubleX2 -> Evidence-    AIDoubleX3 -> Evidence-    AIDoubleX4 -> 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-    AIDoubleX2 -> Evidence-    AIDoubleX3 -> Evidence-    AIDoubleX4 -> 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

@@ -1,224 +0,0 @@-{-# LANGUAGE DataKinds                 #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE KindSignatures            #-}-{-# LANGUAGE MagicHash                 #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE TypeApplications          #-}-{-# LANGUAGE TypeFamilies              #-}-{-# LANGUAGE UnboxedTuples             #-}-{-# LANGUAGE TypeOperators             #-}--------------------------------------------------------------------------------- |--- Module      :  Numeric.DataFrame.Mutable--- Copyright   :  (c) Artem Chirkin--- License     :  BSD3------ Maintainer  :  chirkin@arch.ethz.ch------ Interfrace to perform primitive stateful operations on mutable frames.-----------------------------------------------------------------------------------module Numeric.DataFrame.Mutable-    ( MutableFrame (..), MDataFrame ()-    , newDataFrame#, copyDataFrame#, copyMDataFrame#, unsafeFreezeDataFrame#-    , freezeDataFrame#, thawDataFrame#-    , writeDataFrame#, readDataFrame#-    ) where---import           GHC.Int                (Int16 (..), Int32 (..), Int64 (..),-                                         Int8 (..))-import           GHC.Prim-import           GHC.Types              (Double (..), Float (..), Int (..),-                                         Word (..))-import           GHC.Word               (Word16 (..), Word32 (..), Word64 (..),-                                         Word8 (..))--import           Numeric.Commons-import           Numeric.DataFrame.Type-import           Numeric.Dimensions-import           Numeric.TypeLits----- | Mutable DataFrame type-data MDataFrame s t (ns :: [Nat]) = MDataFrame# Int# Int# (MutableByteArray# s)---- | Create a new mutable DataFrame.-newDataFrame# :: forall t (ns :: [Nat]) s-               . ( PrimBytes t, Dimensions ns)-              => State# s -> (# State# s, MDataFrame s t ns #)-newDataFrame# s0-    | elS  <- elementByteSize (undefined :: t)-    , I# n <- totalDim (Proxy @ns)-    , (# s1, mba #) <- newByteArray# (n *# elS) s0-    = (# s1,  MDataFrame# 0# n mba #)-{-# INLINE newDataFrame# #-}---- | Copy one DataFrame into another mutable DataFrame at specified position.-copyDataFrame# :: forall t (as :: [Nat]) (b' :: Nat) (b :: Nat) (bs :: [Nat]) (asbs :: [Nat]) s-                . ( PrimBytes (DataFrame t (as +: b'))-                  , ConcatList as (b :+ bs) asbs-                  , Dimensions (b :+ bs)-                  )-               => DataFrame t (as +: b') -> Idx (b :+ bs) -> MDataFrame s t asbs -> State# s -> (# State# s, () #)-copyDataFrame# df ei (MDataFrame# offM _ arrM) s-    | (# offA, lenA, arrA #) <- toBytes df-    , elS <- elementByteSize df-    , I# i <- fromEnum ei-    = (# copyByteArray# arrA (offA *# elS) arrM ((offM +# i) *# elS) (lenA *# elS) s, () #)-{-# INLINE copyDataFrame# #-}---- | Copy one mutable DataFrame into another mutable DataFrame at specified position.-copyMDataFrame# :: forall t (as :: [Nat]) (b' :: Nat) (b :: Nat) (bs :: [Nat]) (asbs :: [Nat]) s-                . ( PrimBytes t-                  , ConcatList as (b :+ bs) asbs-                  , Dimensions (b :+ bs)-                  )-               => MDataFrame s t (as +: b') -> Idx (b :+ bs) -> MDataFrame s t asbs -> State# s -> (# State# s, () #)-copyMDataFrame# (MDataFrame# offA lenA arrA) ei (MDataFrame# offM _ arrM) s-    | elS <- elementByteSize (undefined :: t)-    , I# i <- fromEnum ei-    = (# copyMutableByteArray# arrA (offA *# elS) arrM ((offM +# i) *# elS) (lenA *# elS) s, () #)-{-# INLINE copyMDataFrame# #-}---- | Make a mutable DataFrame immutable, without copying.-unsafeFreezeDataFrame# :: forall t (ns :: [Nat]) s-                        . PrimBytes (DataFrame t ns)-                       => MDataFrame s t ns -> State# s -> (# State# s, DataFrame t ns #)-unsafeFreezeDataFrame# (MDataFrame# offM lenM arrM) s1-    | (# s2, arrA #) <- unsafeFreezeByteArray# arrM s1-    = (# s2, fromBytes (# offM, lenM, arrA #) #)-{-# INLINE unsafeFreezeDataFrame# #-}---- | Copy content of a mutable DataFrame into a new immutable DataFrame.-freezeDataFrame# :: forall t (ns :: [Nat]) s-                  . PrimBytes (DataFrame t ns)-                 => MDataFrame s t ns -> State# s -> (# State# s, DataFrame t ns #)-freezeDataFrame# (MDataFrame# offM n arrM) s0-    | elS  <- elementByteSize (undefined :: DataFrame t ns)-    , (# s1, mba #) <- newByteArray# (n *# elS) s0-    , s2 <- copyMutableByteArray# arrM (offM *# elS) mba 0# (n *# elS) s1-    , (# s3, arrA #) <- unsafeFreezeByteArray# mba s2-    = (# s3, fromBytes (# 0#, n, arrA #) #)-{-# INLINE freezeDataFrame# #-}---- | Create a new mutable DataFrame and copy content of immutable one in there.-thawDataFrame# :: forall t (ns :: [Nat]) s-                . PrimBytes (DataFrame t ns)-               => DataFrame t ns -> State# s -> (# State# s, MDataFrame s t ns #)-thawDataFrame# df s0-    | elS  <- elementByteSize (undefined :: DataFrame t ns)-    , (# offA, n, arrA #) <- toBytes df-    , (# s1, arrM #) <- newByteArray# (n *# elS) s0-    , s2 <- copyByteArray# arrA (offA *# elS) arrM 0# (n *# elS) s1-    = (# s2, MDataFrame# 0# n arrM #)-{-# INLINE thawDataFrame# #-}---- | Write a single element at the specified index-writeDataFrame# :: forall t (ns :: [Nat]) s-                . ( MutableFrame t ns, Dimensions ns )-               => MDataFrame s t ns -> Idx ns -> t -> State# s -> (# State# s, () #)-writeDataFrame# mdf ei x s | I# i <- fromEnum ei = (# writeDataFrameOff# mdf i x s, () #)-{-# INLINE writeDataFrame# #-}---- | Read a single element at the specified index-readDataFrame# :: forall t (ns :: [Nat]) s-                . ( MutableFrame t ns, Dimensions ns )-               => MDataFrame s t ns -> Idx ns -> State# s -> (# State# s, t #)-readDataFrame# mdf ei | I# i <- fromEnum ei = readDataFrameOff# mdf i-{-# INLINE readDataFrame# #-}--class MutableFrame t (ns :: [Nat]) where-    -- | Write a single element at the specified element offset-    writeDataFrameOff# :: MDataFrame s t ns -> Int# -> t -> State# s -> State# s-    -- | Read a single element at the specified element offset-    readDataFrameOff# :: MDataFrame s t ns -> Int# -> State# s -> (# State# s, t #)--instance MutableFrame Float (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (F# x) = writeFloatArray# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readFloatArray# arr (off +# i) s0 = (# s1, F# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Double (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (D# x) = writeDoubleArray# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readDoubleArray# arr (off +# i) s0 = (# s1, D# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Int (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (I# x) = writeIntArray# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readIntArray# arr (off +# i) s0 = (# s1, I# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Int8 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (I8# x) = writeInt8Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readInt8Array# arr (off +# i) s0 = (# s1, I8# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Int16 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (I16# x) = writeInt16Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readInt16Array# arr (off +# i) s0 = (# s1, I16# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Int32 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (I32# x) = writeInt32Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readInt32Array# arr (off +# i) s0 = (# s1, I32# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Int64 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (I64# x) = writeInt64Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readInt64Array# arr (off +# i) s0 = (# s1, I64# r #)-    {-# INLINE readDataFrameOff# #-}---instance MutableFrame Word (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (W# x) = writeWordArray# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readWordArray# arr (off +# i) s0 = (# s1, W# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Word8 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (W8# x) = writeWord8Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readWord8Array# arr (off +# i) s0 = (# s1, W8# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Word16 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (W16# x) = writeWord16Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readWord16Array# arr (off +# i) s0 = (# s1, W16# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Word32 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (W32# x) = writeWord32Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readWord32Array# arr (off +# i) s0 = (# s1, W32# r #)-    {-# INLINE readDataFrameOff# #-}--instance MutableFrame Word64 (ns :: [Nat]) where-    writeDataFrameOff# (MDataFrame# off _ arr) i (W64# x) = writeWord64Array# arr (off +# i) x-    {-# INLINE writeDataFrameOff# #-}-    readDataFrameOff#  (MDataFrame# off _ arr) i s0-      | (# s1, r #) <- readWord64Array# arr (off +# i) s0 = (# s1, W64# r #)-    {-# INLINE readDataFrameOff# #-}

@@ -1,37 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans  #-}-module Numeric.Matrix.Mat44d () where---import Numeric.Matrix.Class--notYet :: a-notYet = error "Sorry, this function is not implemented for current platform yet."--instance HomTransform4 Double where-    translate4 = notYet-    {-# INLINE translate4 #-}-    translate3 = notYet-    {-# INLINE translate3 #-}-    rotateX = notYet-    {-# INLINE rotateX #-}-    rotateY = notYet-    {-# INLINE rotateY #-}-    rotateZ = notYet-    {-# INLINE rotateZ #-}-    rotate = notYet-    {-# INLINE rotate #-}-    rotateEuler = notYet-    {-# INLINE rotateEuler #-}-    lookAt = notYet-    {-# INLINE lookAt #-}-    perspective = notYet-    {-# INLINE perspective #-}-    orthogonal = notYet-    {-# INLINE orthogonal #-}-    toHomPoint = notYet-    {-# INLINE toHomPoint #-}-    toHomVector = notYet-    {-# INLINE toHomVector #-}-    fromHom = notYet-    {-# INLINE fromHom #-}-

@@ -1,37 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans  #-}-module Numeric.Matrix.Mat44f () where---import Numeric.Matrix.Class--notYet :: a-notYet = error "Sorry, this function is not implemented for current platform yet."--instance HomTransform4 Float where-    translate4 = notYet-    {-# INLINE translate4 #-}-    translate3 = notYet-    {-# INLINE translate3 #-}-    rotateX = notYet-    {-# INLINE rotateX #-}-    rotateY = notYet-    {-# INLINE rotateY #-}-    rotateZ = notYet-    {-# INLINE rotateZ #-}-    rotate = notYet-    {-# INLINE rotate #-}-    rotateEuler = notYet-    {-# INLINE rotateEuler #-}-    lookAt = notYet-    {-# INLINE lookAt #-}-    perspective = notYet-    {-# INLINE perspective #-}-    orthogonal = notYet-    {-# INLINE orthogonal #-}-    toHomPoint = notYet-    {-# INLINE toHomPoint #-}-    toHomVector = notYet-    {-# INLINE toHomVector #-}-    fromHom = notYet-    {-# INLINE fromHom #-}-

@@ -1,542 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# OPTIONS_GHC -fno-warn-orphans  #-}-module Numeric.Quaternion.QDouble-    ( QDouble, Quater (..)-    ) where--import GHC.Exts-import Data.Coerce (coerce)--import Numeric.Array-import Numeric.DataFrame.Type-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Scalar-import Numeric.Vector-import Numeric.Matrix-import qualified Numeric.DataFrame.ST as ST-import qualified Numeric.Dimensions.Traverse.ST as ST-import qualified Control.Monad.ST as ST--import Numeric.Quaternion.Class---type QDouble = Quater Double--instance Quaternion Double where-    newtype Quater Double = QDouble DoubleX4-    {-# INLINE packQ #-}-    packQ (D# x) (D# y) (D# z) (D# w) = QDouble (DoubleX4# x y z w)-    {-# INLINE unpackQ #-}-    unpackQ (QDouble (DoubleX4# x y z w)) = (D# x, D# y, D# z, D# w)-    {-# INLINE fromVecNum #-}-    fromVecNum (KnownDataFrame (DoubleX3# x y z)) (D# w) = QDouble (DoubleX4# x y z w)-    {-# INLINE fromVec4 #-}-    fromVec4 = coerce-    {-# INLINE toVec4 #-}-    toVec4 = coerce-    {-# INLINE square #-}-    square q = D# (qdot q)-    {-# INLINE im #-}-    im (QDouble (DoubleX4# x y z _)) = QDouble (DoubleX4# x y z 0.0##)-    {-# INLINE re #-}-    re (QDouble (DoubleX4# _ _ _ w)) = QDouble (DoubleX4# 0.0## 0.0## 0.0## w)-    {-# INLINE imVec #-}-    imVec (QDouble (DoubleX4# x y z _)) = KnownDataFrame (DoubleX3# x y z)-    {-# INLINE taker #-}-    taker (QDouble (DoubleX4# _ _ _ w)) = D# w-    {-# INLINE takei #-}-    takei (QDouble (DoubleX4# x _ _ _)) = D# x-    {-# INLINE takej #-}-    takej (QDouble (DoubleX4# _ y _ _)) = D# y-    {-# INLINE takek #-}-    takek (QDouble (DoubleX4# _ _ z _)) = D# z-    {-# INLINE conjugate #-}-    conjugate (QDouble (DoubleX4# x y z w)) = QDouble (DoubleX4#-                                                (negateDouble# x)-                                                (negateDouble# y)-                                                (negateDouble# z) w)-    {-# INLINE rotScale #-}-    rotScale (QDouble (DoubleX4# i j k t))-             (KnownDataFrame (DoubleX3# x y z))-      = let l = t*##t -## i*##i -## j*##j -## k*##k-            d = 2.0## *## ( i*##x +## j*##y +## k*##z)-            t2 = t *## 2.0##-        in KnownDataFrame-            ( DoubleX3#-                (l*##x +## d*##i +## t2 *## (z*##j -## y*##k))-                (l*##y +## d*##j +## t2 *## (x*##k -## z*##i))-                (l*##z +## d*##k +## t2 *## (y*##i -## x*##j))-            )-    {-# INLINE getRotScale #-}-    getRotScale _ (KnownDataFrame (DoubleX3# 0.0## 0.0## 0.0##))-      = QDouble (DoubleX4# 0.0## 0.0## 0.0## 0.0##)-    getRotScale (KnownDataFrame (DoubleX3# 0.0## 0.0## 0.0##)) _-      = case infty of D# x -> QDouble (DoubleX4# x x x x)-    getRotScale a@(KnownDataFrame (DoubleX3# a1 a2 a3))-                b@(KnownDataFrame (DoubleX3# b1 b2 b3))-      = let ma = sqrtDouble# (a1*##a1 +## a2*##a2 +## a3*##a3)-            mb = sqrtDouble# (b1*##b1 +## b2*##b2 +## b3*##b3)-            d  = a1*##b1 +## a2*##b2 +## a3*##b3-            c  = sqrtDouble# (ma*##mb +## d)-            ma2 = ma *## sqrtDouble# 2.0##-            r  = 1.0## /## (ma2 *## c)-        in case cross a b of-          KnownDataFrame (DoubleX3# 0.0## 0.0## 0.0##) ->-            if isTrue# (d >## 0.0##)-            then QDouble (DoubleX4#  0.0## 0.0## 0.0## (sqrtDouble# (mb /## ma)))-                 -- Shall we move result from k to i component?-            else QDouble (DoubleX4#  0.0## 0.0## (sqrtDouble# (mb /## ma)) 0.0##)-          KnownDataFrame (DoubleX3# t1 t2 t3) -> QDouble-                ( DoubleX4#-                    (t1 *## r)-                    (t2 *## r)-                    (t3 *## r)-                    (c /## ma2)-                )-    {-# INLINE axisRotation #-}-    axisRotation (KnownDataFrame (DoubleX3# 0.0## 0.0## 0.0##)) _-      = QDouble (DoubleX4# 0.0## 0.0## 0.0## 1.0##)-    axisRotation (KnownDataFrame (DoubleX3# x y z)) (D# a)-      = let c = cosDouble# (a *## 0.5##)-            s = sinDouble# (a *## 0.5##)-                /## sqrtDouble# (x*##x +## y*##y +## z*##z)-        in QDouble-              ( DoubleX4#-                  (x *## s)-                  (y *## s)-                  (z *## s)-                  c-              )-    {-# INLINE qArg #-}-    qArg (QDouble (DoubleX4# x y z w))-       = case atan2 (D# (sqrtDouble# (x*##x +## y*##y +## z*##z)))-                    (D# w) of-           D# a -> D# (a *## 2.0##)-    {-# INLINE fromMatrix33 #-}-    fromMatrix33 m-      = let d =-              (  ix 0# m *## ( ix 4# m *## ix 8# m -## ix 5# m *## ix 7# m )-              -## ix 1# m *## ( ix 3# m *## ix 8# m -## ix 5# m *## ix 6# m )-              +## ix 2# m *## ( ix 3# m *## ix 7# m -## ix 4# m *## ix 6# m )-              ) **## 0.33333333333333333333333333333333##-        in QDouble-           ( DoubleX4#-            (sqrtDouble# (max# 0.0## (d +## ix 0# m -## ix 4# m -## ix 8# m )) *## sign# (ix 5# m -## ix 7# m) *## 0.5##)-            (sqrtDouble# (max# 0.0## (d -## ix 0# m +## ix 4# m -## ix 8# m )) *## sign# (ix 6# m -## ix 2# m) *## 0.5##)-            (sqrtDouble# (max# 0.0## (d -## ix 0# m -## ix 4# m +## ix 8# m )) *## sign# (ix 1# m -## ix 3# m) *## 0.5##)-            (sqrtDouble# (max# 0.0## (d +## ix 0# m +## ix 4# m +## ix 8# m )) *## 0.5##)-           )-    {-# INLINE fromMatrix44 #-}-    fromMatrix44 m-      = let d =-              (  ix 0# m *## ( ix 5# m *## ix 10# m -## ix 6# m *## ix 9# m )-              -## ix 1# m *## ( ix 4# m *## ix 10# m -## ix 6# m *## ix 8# m )-              +## ix 2# m *## ( ix 4# m *## ix  9# m -## ix 5# m *## ix 8# m )-              ) **## 0.33333333333333333333333333333333##-            c = 0.5## /## ix 15# m-        in QDouble-           ( DoubleX4#-            (sqrtDouble# (max# 0.0## (d +## ix 0# m -## ix 5# m -## ix 10# m )) *## sign# (ix 6# m -## ix 9# m) *## c)-            (sqrtDouble# (max# 0.0## (d -## ix 0# m +## ix 5# m -## ix 10# m )) *## sign# (ix 8# m -## ix 2# m) *## c)-            (sqrtDouble# (max# 0.0## (d -## ix 0# m -## ix 5# m +## ix 10# m )) *## sign# (ix 1# m -## ix 4# m) *## c)-            (sqrtDouble# (max# 0.0## (d +## ix 0# m +## ix 5# m +## ix 10# m )) *## c)-           )-    {-# INLINE toMatrix33 #-}-    toMatrix33 (QDouble (DoubleX4# 0.0## 0.0## 0.0## w)) = diag (scalar (D# (w *## w)))-    toMatrix33 (QDouble (DoubleX4# x' y' z' w')) =-      let x = scalar (D# x')-          y = scalar (D# y')-          z = scalar (D# z')-          w = scalar (D# w')-          x2 = x * x-          y2 = y * y-          z2 = z * z-          w2 = w * w-          l2 = x2 + y2 + z2 + w2-      in ST.runST $ do-        df <- ST.newDataFrame-        ST.writeDataFrameOff df 0 $ l2 - 2*(z2 + y2)-        ST.writeDataFrameOff df 1 $ 2*(x*y + z*w)-        ST.writeDataFrameOff df 2 $ 2*(x*z - y*w)-        ST.writeDataFrameOff df 3 $ 2*(x*y - z*w)-        ST.writeDataFrameOff df 4 $ l2 - 2*(z2 + x2)-        ST.writeDataFrameOff df 5 $ 2*(y*z + x*w)-        ST.writeDataFrameOff df 6 $ 2*(x*z + y*w)-        ST.writeDataFrameOff df 7 $ 2*(y*z - x*w)-        ST.writeDataFrameOff df 8 $ l2 - 2*(y2 + x2)-        ST.unsafeFreezeDataFrame df-    {-# INLINE toMatrix44 #-}-    toMatrix44 (QDouble (DoubleX4# 0.0## 0.0## 0.0## w)) = ST.runST $ do-      df <- ST.newDataFrame-      ST.overDimOff_ (dim :: Dim '[4,4]) (\i -> ST.writeDataFrameOff df (I# i) 0) 0# 1#-      let w2 = scalar (D# (w *## w))-      ST.writeDataFrameOff df 0 w2-      ST.writeDataFrameOff df 5 w2-      ST.writeDataFrameOff df 10 w2-      ST.writeDataFrameOff df 15 1-      ST.unsafeFreezeDataFrame df-    toMatrix44 (QDouble (DoubleX4# x' y' z' w')) =-      let x = scalar (D# x')-          y = scalar (D# y')-          z = scalar (D# z')-          w = scalar (D# w')-          x2 = x * x-          y2 = y * y-          z2 = z * z-          w2 = w * w-          l2 = x2 + y2 + z2 + w2-      in ST.runST $ do-        df <- ST.newDataFrame-        ST.writeDataFrameOff df 0 $ l2 - 2*(z2 + y2)-        ST.writeDataFrameOff df 1 $ 2*(x*y + z*w)-        ST.writeDataFrameOff df 2 $ 2*(x*z - y*w)-        ST.writeDataFrameOff df 3 0-        ST.writeDataFrameOff df 4 $ 2*(x*y - z*w)-        ST.writeDataFrameOff df 5 $ l2 - 2*(z2 + x2)-        ST.writeDataFrameOff df 6 $ 2*(y*z + x*w)-        ST.writeDataFrameOff df 7 0-        ST.writeDataFrameOff df 8 $ 2*(x*z + y*w)-        ST.writeDataFrameOff df 9 $ 2*(y*z - x*w)-        ST.writeDataFrameOff df 10 $ l2 - 2*(y2 + x2)-        ST.writeDataFrameOff df 11 0-        ST.writeDataFrameOff df 12 0-        ST.writeDataFrameOff df 13 0-        ST.writeDataFrameOff df 14 0-        ST.writeDataFrameOff df 15 1-        ST.unsafeFreezeDataFrame df--qdot :: QDouble -> Double#-qdot (QDouble (DoubleX4# x y z w)) = (x *## x) +##-                                   (y *## y) +##-                                   (z *## z) +##-                                   (w *## w)-{-# INLINE qdot #-}--infty :: Double-infty = read "Infinity"--max# :: Double# -> Double# -> Double#-max# a b | isTrue# (a >## b) = a-         | otherwise = b-{-# INLINE max# #-}--sign# :: Double# -> Double#-sign# a | isTrue# (a >## 0.0##) = 1.0##-        | isTrue# (a <## 0.0##) = negateDouble# 1.0##-        | otherwise = 0.0##-{-# INLINE sign# #-}------------------------------------------------------------------------------- Num-----------------------------------------------------------------------------instance Num QDouble where-    QDouble a + QDouble b-      = QDouble (a + b)-    {-# INLINE (+) #-}-    QDouble a - QDouble b-      = QDouble (a - b)-    {-# INLINE (-) #-}-    QDouble (DoubleX4# a1 a2 a3 a4) * QDouble (DoubleX4# b1 b2 b3 b4)-      = QDouble-         ( DoubleX4#-           ((a4 *## b1) +##-            (a1 *## b4) +##-            (a2 *## b3) -##-            (a3 *## b2)-            )-           ((a4 *## b2) -##-            (a1 *## b3) +##-            (a2 *## b4) +##-            (a3 *## b1)-            )-           ((a4 *## b3) +##-            (a1 *## b2) -##-            (a2 *## b1) +##-            (a3 *## b4)-            )-           ((a4 *## b4) -##-            (a1 *## b1) -##-            (a2 *## b2) -##-            (a3 *## b3)-            )-         )-    {-# INLINE (*) #-}-    negate (QDouble a) = QDouble (negate a)-    {-# INLINE negate #-}-    abs q = QDouble (DoubleX4# 0.0## 0.0## 0.0## (sqrtDouble# (qdot q)))-    {-# INLINE abs #-}-    signum q@(QDouble (DoubleX4# x y z w))-      = case qdot q of-          0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## 0.0##)-          qd -> case 1.0## /## sqrtDouble# qd of-             s -> QDouble-               ( DoubleX4#-                (x *## s)-                (y *## s)-                (z *## s)-                (w *## s)-               )-    {-# INLINE signum #-}-    fromInteger n = case fromInteger n of-      D# x -> QDouble (DoubleX4# 0.0## 0.0## 0.0## x)-    {-# INLINE fromInteger #-}--------------------------------------------------------------------------------- Fractional-----------------------------------------------------------------------------instance Fractional QDouble where-    {-# INLINE recip #-}-    recip q@(QDouble (DoubleX4# x y z w)) = case -1.0## /## qdot q of-      c -> QDouble-        ( DoubleX4#-         (x *## c)-         (y *## c)-         (z *## c)-         (negateDouble# (w *## c))-        )-    {-# INLINE (/) #-}-    a / b = a * recip b-    {-# INLINE fromRational #-}-    fromRational q = case fromRational q of-      D# x -> QDouble (DoubleX4# 0.0## 0.0## 0.0## x)------------------------------------------------------------------------------- Doubleing-----------------------------------------------------------------------------instance  Floating QDouble where-    {-# INLINE pi #-}-    pi = QDouble (DoubleX4# 0.0## 0.0## 0.0##-                          3.141592653589793##)-    {-# INLINE exp #-}-    exp (QDouble (DoubleX4# x y z w))-      = case (# (x *## x) +##-                (y *## y) +##-                (z *## z)-             , expDouble# w-             #) of-        (# 0.0##, et #) -> QDouble (DoubleX4# 0.0## 0.0## 0.0## et)-        (# mv2, et #) -> case sqrtDouble# mv2 of-          mv -> case et *## sinDouble# mv-                        /## mv of-            l -> QDouble-              ( DoubleX4#-               (x *## l)-               (y *## l)-               (z *## l)-               (et *## cosDouble# mv)-              )-    {-# INLINE log #-}-    log (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> if isTrue# (w >=## 0.0##)-                then QDouble (DoubleX4# 0.0## 0.0## 0.0## (logDouble# w))-                else QDouble (DoubleX4# 3.141592653589793## 0.0## 0.0##-                                     (logDouble# (negateDouble# w)))-        mv2 -> case (# sqrtDouble# (mv2 +## (w *## w))-                     , sqrtDouble# mv2-                    #) of-          (# mq, mv #) -> case atan2 (D# mv) (D# w) / D# mv of-            D# l -> QDouble-              ( DoubleX4#-               (x *## l)-               (y *## l)-               (z *## l)-               (logDouble# mq)-              )-    {-# INLINE sqrt #-}-    sqrt (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> if isTrue# (w >=## 0.0##)-                then QDouble (DoubleX4# 0.0## 0.0## 0.0## (sqrtDouble# w))-                else QDouble (DoubleX4# (sqrtDouble# (negateDouble# w)) 0.0## 0.0## 0.0##)-        mv2 ->-          let mq = sqrtDouble# (mv2 +## w *## w)-              l2 = sqrtDouble# mq-              tq = w /## (mq *## 2.0##)-              sina = sqrtDouble# (0.5## -## tq) *## l2 /## sqrtDouble# mv2-          in QDouble-                ( DoubleX4#-                 (x *## sina)-                 (y *## sina)-                 (z *## sina)-                 (sqrtDouble# (0.5## +## tq) *## l2)-                )-    {-# INLINE sin #-}-    sin (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## (sinDouble# w))-        mv2 -> case sqrtDouble# mv2 of-          mv -> case cosDouble# w *## sinhDouble# mv-                                 /## mv of-            l -> QDouble-              ( DoubleX4#-               (x *## l)-               (y *## l)-               (z *## l)-               (sinDouble# w *## coshDouble# mv)-              )-    {-# INLINE cos #-}-    cos (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## (cosDouble# w))-        mv2 -> case sqrtDouble# mv2 of-          mv -> case sinDouble# w *## sinhDouble# mv-                                 /## negateDouble# mv of-            l -> QDouble-              ( DoubleX4#-               (x *## l)-               (y *## l)-               (z *## l)-               (cosDouble# w *## coshDouble# mv)-              )-    {-# INLINE tan #-}-    tan (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## (tanDouble# w))-        mv2 ->-          let mv = sqrtDouble# mv2-              chv = coshDouble# mv-              shv = sinhDouble# mv-              ct = cosDouble# w-              st = sinDouble# w-              cq = 1.0## /##-                  ( (ct *## ct *## chv *## chv)-                    +##-                    (st *## st *## shv *## shv)-                  )-              l = chv *## shv *## cq-                      /## mv-          in QDouble-            ( DoubleX4#-             (x *## l)-             (y *## l)-             (z *## l)-             (ct *## st *## cq)-            )-    {-# INLINE sinh #-}-    sinh (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## (sinhDouble# w))-        mv2 -> case sqrtDouble# mv2 of-          mv -> case coshDouble# w *## sinDouble# mv-                                  /## mv of-            l -> QDouble-              ( DoubleX4#-               (x *## l)-               (y *## l)-               (z *## l)-               (sinhDouble# w *## cosDouble# mv)-              )-    {-# INLINE cosh #-}-    cosh (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## (coshDouble# w))-        mv2 -> case sqrtDouble# mv2 of-          mv -> case sinhDouble# w *## sinDouble# mv-                                  /## mv of-            l -> QDouble-              ( DoubleX4#-               (x *## l)-               (y *## l)-               (z *## l)-               (coshDouble# w *## cosDouble# mv)-              )-    {-# INLINE tanh #-}-    tanh (QDouble (DoubleX4# x y z w))-      = case (x *## x) +##-             (y *## y) +##-             (z *## z) of-        0.0## -> QDouble (DoubleX4# 0.0## 0.0## 0.0## (tanhDouble# w))-        mv2 ->-          let mv = sqrtDouble# mv2-              cv = cosDouble# mv-              sv = sinDouble# mv-              cht = coshDouble# w-              sht = sinhDouble# w-              cq = 1.0## /##-                  ( (cht *## cht *## cv *## cv)-                    +##-                    (sht *## sht *## sv *## sv)-                  )-              l = cv *## sv *## cq-                      /## mv-          in QDouble-            ( DoubleX4#-             (x *## l)-             (y *## l)-             (z *## l)-             (cht *## sht *## cq)-            )-    {-# INLINE asin #-}-    asin q = -i * log (i*q + sqrt (1 - q*q))-        where-          i = case signum . im $ q of-                0 -> QDouble (DoubleX4# 1.0## 0.0## 0.0## 0.0##)-                i' -> i'-    {-# INLINE acos #-}-    acos q = pi/2 - asin q-    {-# INLINE atan #-}-    atan q@(QDouble (DoubleX4# _ _ _ w))-      = if square imq == 0-        then QDouble (DoubleX4# 0.0## 0.0## 0.0## (atanDouble# w))-        else i / 2 * log ( (i + q) / (i - q) )-      where-        i = signum imq-        imq = im q-    {-# INLINE asinh #-}-    asinh q = log (q + sqrt (q*q + 1))-    {-# INLINE acosh #-}-    acosh q = log (q + sqrt (q*q - 1))-    {-# INLINE atanh #-}-    atanh q = 0.5 * log ((1+q)/(1-q))------------------------------------------------------------------------------- Eq-----------------------------------------------------------------------------instance Eq QDouble where-    {-# INLINE (==) #-}-    QDouble a == QDouble b = a == b-    {-# INLINE (/=) #-}-    QDouble a /= QDouble b = a /= b--------------------------------------------------------------------------------- Show-----------------------------------------------------------------------------instance Show QDouble where-    show (QDouble (DoubleX4# x y z w)) =-        show (D# w) ++ ss x ++ "i"-                    ++ ss y ++ "j"-                    ++ ss z ++ "k"-      where-        ss a# = case D# a# of-          a -> if a >= 0 then " + " ++ show a-                         else " - " ++ show (negate a)

@@ -1,562 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}-{-# OPTIONS_GHC -fno-warn-orphans  #-}-module Numeric.Quaternion.QFloat-    ( QFloat, Quater (..)-    ) where--import GHC.Exts-import Data.Coerce (coerce)--import Numeric.Array-import Numeric.DataFrame.Type-import Numeric.Commons-import Numeric.Dimensions-import Numeric.Scalar-import Numeric.Vector-import Numeric.Matrix-import qualified Numeric.DataFrame.ST as ST-import qualified Numeric.Dimensions.Traverse.ST as ST-import qualified Control.Monad.ST as ST--import Numeric.Quaternion.Class---type QFloat = Quater Float--instance Quaternion Float where-    newtype Quater Float = QFloat FloatX4-    {-# INLINE packQ #-}-    packQ (F# x) (F# y) (F# z) (F# w) = QFloat (FloatX4# x y z w)-    {-# INLINE unpackQ #-}-    unpackQ (QFloat (FloatX4# x y z w)) = (F# x, F# y, F# z, F# w)-    {-# INLINE fromVecNum #-}-    fromVecNum (KnownDataFrame (FloatX3# x y z)) (F# w) = QFloat (FloatX4# x y z w)-    {-# INLINE fromVec4 #-}-    fromVec4 = coerce-    {-# INLINE toVec4 #-}-    toVec4 = coerce-    {-# INLINE square #-}-    square q = F# (qdot q)-    {-# INLINE im #-}-    im (QFloat (FloatX4# x y z _)) = QFloat (FloatX4# x y z 0.0#)-    {-# INLINE re #-}-    re (QFloat (FloatX4# _ _ _ w)) = QFloat (FloatX4# 0.0# 0.0# 0.0# w)-    {-# INLINE imVec #-}-    imVec (QFloat (FloatX4# x y z _)) = KnownDataFrame (FloatX3# x y z)-    {-# INLINE taker #-}-    taker (QFloat (FloatX4# _ _ _ w)) = F# w-    {-# INLINE takei #-}-    takei (QFloat (FloatX4# x _ _ _)) = F# x-    {-# INLINE takej #-}-    takej (QFloat (FloatX4# _ y _ _)) = F# y-    {-# INLINE takek #-}-    takek (QFloat (FloatX4# _ _ z _)) = F# z-    {-# INLINE conjugate #-}-    conjugate (QFloat (FloatX4# x y z w)) = QFloat (FloatX4#-                                                (negateFloat# x)-                                                (negateFloat# y)-                                                (negateFloat# z) w)-    {-# INLINE rotScale #-}-    rotScale (QFloat (FloatX4# i j k t))-             (KnownDataFrame (FloatX3# x y z))-      = let l = t*%t -% i*%i -% j*%j -% k*%k-            d = 2.0# *% ( i*%x +% j*%y +% k*%z)-            t2 = t *% 2.0#-        in KnownDataFrame-            ( FloatX3#-                (l*%x +% d*%i +% t2 *% (z*%j -% y*%k))-                (l*%y +% d*%j +% t2 *% (x*%k -% z*%i))-                (l*%z +% d*%k +% t2 *% (y*%i -% x*%j))-            )-    {-# INLINE getRotScale #-}-    getRotScale _ (KnownDataFrame (FloatX3# 0.0# 0.0# 0.0#))-      = QFloat (FloatX4# 0.0# 0.0# 0.0# 0.0#)-    getRotScale (KnownDataFrame (FloatX3# 0.0# 0.0# 0.0#)) _-      = case infty of F# x -> QFloat (FloatX4# x x x x)-    getRotScale a@(KnownDataFrame (FloatX3# a1 a2 a3))-                b@(KnownDataFrame (FloatX3# b1 b2 b3))-      = let ma = sqrtFloat# (a1*%a1 +% a2*%a2 +% a3*%a3)-            mb = sqrtFloat# (b1*%b1 +% b2*%b2 +% b3*%b3)-            d  = a1*%b1 +% a2*%b2 +% a3*%b3-            c  = sqrtFloat# (ma*%mb +% d)-            ma2 = ma *% sqrtFloat# 2.0#-            r  = 1.0# /% (ma2 *% c)-        in case cross a b of-          KnownDataFrame (FloatX3# 0.0# 0.0# 0.0#) ->-            if isTrue# (gtFloat# d 0.0#)-            then QFloat (FloatX4#  0.0# 0.0# 0.0# (sqrtFloat# (mb /% ma)))-                 -- Shall we move result from k to i component?-            else QFloat (FloatX4#  0.0# 0.0# (sqrtFloat# (mb /% ma)) 0.0#)-          KnownDataFrame (FloatX3# t1 t2 t3) -> QFloat-                ( FloatX4#-                    (t1 *% r)-                    (t2 *% r)-                    (t3 *% r)-                    (c /% ma2)-                )-    {-# INLINE axisRotation #-}-    axisRotation (KnownDataFrame (FloatX3# 0.0# 0.0# 0.0#)) _-      = QFloat (FloatX4# 0.0# 0.0# 0.0# 1.0#)-    axisRotation (KnownDataFrame (FloatX3# x y z)) (F# a)-      = let c = cosFloat# (a *% 0.5#)-            s = sinFloat# (a *% 0.5#)-                /% sqrtFloat# (x*%x +% y*%y +% z*%z)-        in QFloat-              ( FloatX4#-                  (x *% s)-                  (y *% s)-                  (z *% s)-                  c-              )-    {-# INLINE qArg #-}-    qArg (QFloat (FloatX4# x y z w))-       = case atan2 (F# (sqrtFloat# (x*%x +% y*%y +% z*%z)))-                    (F# w) of-           F# a -> F# (a *% 2.0#)-    {-# INLINE fromMatrix33 #-}-    fromMatrix33 m-      = let d = powerFloat#-              (  ix 0# m *% ( ix 4# m *% ix 8# m -% ix 5# m *% ix 7# m )-              -% ix 1# m *% ( ix 3# m *% ix 8# m -% ix 5# m *% ix 6# m )-              +% ix 2# m *% ( ix 3# m *% ix 7# m -% ix 4# m *% ix 6# m )-              ) 0.33333333333333333333333333333333#-        in QFloat-           ( FloatX4#-            (sqrtFloat# (max# 0.0# (d +% ix 0# m -% ix 4# m -% ix 8# m )) *% sign# (ix 5# m -% ix 7# m) *% 0.5#)-            (sqrtFloat# (max# 0.0# (d -% ix 0# m +% ix 4# m -% ix 8# m )) *% sign# (ix 6# m -% ix 2# m) *% 0.5#)-            (sqrtFloat# (max# 0.0# (d -% ix 0# m -% ix 4# m +% ix 8# m )) *% sign# (ix 1# m -% ix 3# m) *% 0.5#)-            (sqrtFloat# (max# 0.0# (d +% ix 0# m +% ix 4# m +% ix 8# m )) *% 0.5#)-           )-    {-# INLINE fromMatrix44 #-}-    fromMatrix44 m-      = let d = powerFloat#-              (  ix 0# m *% ( ix 5# m *% ix 10# m -% ix 6# m *% ix 9# m )-              -% ix 1# m *% ( ix 4# m *% ix 10# m -% ix 6# m *% ix 8# m )-              +% ix 2# m *% ( ix 4# m *% ix  9# m -% ix 5# m *% ix 8# m )-              ) 0.33333333333333333333333333333333#-            c = 0.5# /% ix 15# m-        in QFloat-           ( FloatX4#-            (sqrtFloat# (max# 0.0# (d +% ix 0# m -% ix 5# m -% ix 10# m )) *% sign# (ix 6# m -% ix 9# m) *% c)-            (sqrtFloat# (max# 0.0# (d -% ix 0# m +% ix 5# m -% ix 10# m )) *% sign# (ix 8# m -% ix 2# m) *% c)-            (sqrtFloat# (max# 0.0# (d -% ix 0# m -% ix 5# m +% ix 10# m )) *% sign# (ix 1# m -% ix 4# m) *% c)-            (sqrtFloat# (max# 0.0# (d +% ix 0# m +% ix 5# m +% ix 10# m )) *% c)-           )-    {-# INLINE toMatrix33 #-}-    toMatrix33 (QFloat (FloatX4# 0.0# 0.0# 0.0# w)) = diag (scalar (F# (w *% w)))-    toMatrix33 (QFloat (FloatX4# x' y' z' w')) =-      let x = scalar (F# x')-          y = scalar (F# y')-          z = scalar (F# z')-          w = scalar (F# w')-          x2 = x * x-          y2 = y * y-          z2 = z * z-          w2 = w * w-          l2 = x2 + y2 + z2 + w2-      in ST.runST $ do-        df <- ST.newDataFrame-        ST.writeDataFrameOff df 0 $ l2 - 2*(z2 + y2)-        ST.writeDataFrameOff df 1 $ 2*(x*y + z*w)-        ST.writeDataFrameOff df 2 $ 2*(x*z - y*w)-        ST.writeDataFrameOff df 3 $ 2*(x*y - z*w)-        ST.writeDataFrameOff df 4 $ l2 - 2*(z2 + x2)-        ST.writeDataFrameOff df 5 $ 2*(y*z + x*w)-        ST.writeDataFrameOff df 6 $ 2*(x*z + y*w)-        ST.writeDataFrameOff df 7 $ 2*(y*z - x*w)-        ST.writeDataFrameOff df 8 $ l2 - 2*(y2 + x2)-        ST.unsafeFreezeDataFrame df-    {-# INLINE toMatrix44 #-}-    toMatrix44 (QFloat (FloatX4# 0.0# 0.0# 0.0# w)) = ST.runST $ do-      df <- ST.newDataFrame-      ST.overDimOff_ (dim :: Dim '[4,4]) (\i -> ST.writeDataFrameOff df (I# i) 0) 0# 1#-      let w2 = scalar (F# (w *% w))-      ST.writeDataFrameOff df 0 w2-      ST.writeDataFrameOff df 5 w2-      ST.writeDataFrameOff df 10 w2-      ST.writeDataFrameOff df 15 1-      ST.unsafeFreezeDataFrame df-    toMatrix44 (QFloat (FloatX4# x' y' z' w')) =-      let x = scalar (F# x')-          y = scalar (F# y')-          z = scalar (F# z')-          w = scalar (F# w')-          x2 = x * x-          y2 = y * y-          z2 = z * z-          w2 = w * w-          l2 = x2 + y2 + z2 + w2-      in ST.runST $ do-        df <- ST.newDataFrame-        ST.writeDataFrameOff df 0 $ l2 - 2*(z2 + y2)-        ST.writeDataFrameOff df 1 $ 2*(x*y + z*w)-        ST.writeDataFrameOff df 2 $ 2*(x*z - y*w)-        ST.writeDataFrameOff df 3 0-        ST.writeDataFrameOff df 4 $ 2*(x*y - z*w)-        ST.writeDataFrameOff df 5 $ l2 - 2*(z2 + x2)-        ST.writeDataFrameOff df 6 $ 2*(y*z + x*w)-        ST.writeDataFrameOff df 7 0-        ST.writeDataFrameOff df 8 $ 2*(x*z + y*w)-        ST.writeDataFrameOff df 9 $ 2*(y*z - x*w)-        ST.writeDataFrameOff df 10 $ l2 - 2*(y2 + x2)-        ST.writeDataFrameOff df 11 0-        ST.writeDataFrameOff df 12 0-        ST.writeDataFrameOff df 13 0-        ST.writeDataFrameOff df 14 0-        ST.writeDataFrameOff df 15 1-        ST.unsafeFreezeDataFrame df--qdot :: QFloat -> Float#-qdot (QFloat (FloatX4# x y z w)) = (x *% x) +%-                                   (y *% y) +%-                                   (z *% z) +%-                                   (w *% w)-{-# INLINE qdot #-}--(*%) :: Float# -> Float# -> Float#-(*%) = timesFloat#-{-# INLINE (*%) #-}-infixl 7 *%--(-%) :: Float# -> Float# -> Float#-(-%) = minusFloat#-{-# INLINE (-%) #-}-infixl 6 -%--(+%) :: Float# -> Float# -> Float#-(+%) = plusFloat#-{-# INLINE (+%) #-}-infixl 6 +%--(/%) :: Float# -> Float# -> Float#-(/%) = divideFloat#-{-# INLINE (/%) #-}-infixl 7 /%--infty :: Float-infty = read "Infinity"--max# :: Float# -> Float# -> Float#-max# a b | isTrue# (gtFloat# a b) = a-         | otherwise = b-{-# INLINE max# #-}--sign# :: Float# -> Float#-sign# a | isTrue# (gtFloat# a 0.0#) = 1.0#-        | isTrue# (ltFloat# a 0.0#) = negateFloat# 1.0#-        | otherwise = 0.0#-{-# INLINE sign# #-}------------------------------------------------------------------------------- Num-----------------------------------------------------------------------------instance Num QFloat where-    QFloat a + QFloat b-      = QFloat (a + b)-    {-# INLINE (+) #-}-    QFloat a - QFloat b-      = QFloat (a - b)-    {-# INLINE (-) #-}-    QFloat (FloatX4# a1 a2 a3 a4) * QFloat (FloatX4# b1 b2 b3 b4)-      = QFloat-         ( FloatX4#-           ((a4 *% b1) +%-            (a1 *% b4) +%-            (a2 *% b3) -%-            (a3 *% b2)-            )-           ((a4 *% b2) -%-            (a1 *% b3) +%-            (a2 *% b4) +%-            (a3 *% b1)-            )-           ((a4 *% b3) +%-            (a1 *% b2) -%-            (a2 *% b1) +%-            (a3 *% b4)-            )-           ((a4 *% b4) -%-            (a1 *% b1) -%-            (a2 *% b2) -%-            (a3 *% b3)-            )-         )-    {-# INLINE (*) #-}-    negate (QFloat a) = QFloat (negate a)-    {-# INLINE negate #-}-    abs q = QFloat (FloatX4# 0.0# 0.0# 0.0# (sqrtFloat# (qdot q)))-    {-# INLINE abs #-}-    signum q@(QFloat (FloatX4# x y z w))-      = case qdot q of-          0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# 0.0#)-          qd -> case 1.0# /% sqrtFloat# qd of-             s -> QFloat-               ( FloatX4#-                (x *% s)-                (y *% s)-                (z *% s)-                (w *% s)-               )-    {-# INLINE signum #-}-    fromInteger n = case fromInteger n of-      F# x -> QFloat (FloatX4# 0.0# 0.0# 0.0# x)-    {-# INLINE fromInteger #-}--------------------------------------------------------------------------------- Fractional-----------------------------------------------------------------------------instance Fractional QFloat where-    {-# INLINE recip #-}-    recip q@(QFloat (FloatX4# x y z w)) = case -1.0# /% qdot q of-      c -> QFloat-        ( FloatX4#-         (x *% c)-         (y *% c)-         (z *% c)-         (negateFloat# (w *% c))-        )-    {-# INLINE (/) #-}-    a / b = a * recip b-    {-# INLINE fromRational #-}-    fromRational q = case fromRational q of-      F# x -> QFloat (FloatX4# 0.0# 0.0# 0.0# x)------------------------------------------------------------------------------- Floating-----------------------------------------------------------------------------instance  Floating QFloat where-    {-# INLINE pi #-}-    pi = QFloat (FloatX4# 0.0# 0.0# 0.0#-                          3.141592653589793#)-    {-# INLINE exp #-}-    exp (QFloat (FloatX4# x y z w))-      = case (# (x *% x) +%-                (y *% y) +%-                (z *% z)-             , expFloat# w-             #) of-        (# 0.0#, et #) -> QFloat (FloatX4# 0.0# 0.0# 0.0# et)-        (# mv2, et #) -> case sqrtFloat# mv2 of-          mv -> case et *% sinFloat# mv-                        /% mv of-            l -> QFloat-              ( FloatX4#-               (x *% l)-               (y *% l)-               (z *% l)-               (et *% cosFloat# mv)-              )-    {-# INLINE log #-}-    log (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> if isTrue# (w `geFloat#` 0.0#)-                then QFloat (FloatX4# 0.0# 0.0# 0.0# (logFloat# w))-                else QFloat (FloatX4# 3.141592653589793# 0.0# 0.0#-                                     (logFloat# (negateFloat# w)))-        mv2 -> case (# sqrtFloat# (mv2 +% (w *% w))-                     , sqrtFloat# mv2-                    #) of-          (# mq, mv #) -> case atan2 (F# mv) (F# w) / F# mv of-            F# l -> QFloat-              ( FloatX4#-               (x *% l)-               (y *% l)-               (z *% l)-               (logFloat# mq)-              )-    {-# INLINE sqrt #-}-    sqrt (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> if isTrue# (w `geFloat#` 0.0#)-                then QFloat (FloatX4# 0.0# 0.0# 0.0# (sqrtFloat# w))-                else QFloat (FloatX4# (sqrtFloat# (negateFloat# w)) 0.0# 0.0# 0.0#)-        mv2 ->-          let mq = sqrtFloat# (mv2 +% w *% w)-              l2 = sqrtFloat# mq-              tq = w /% (mq *% 2.0#)-              sina = sqrtFloat# (0.5# -% tq) *% l2 /% sqrtFloat# mv2-          in QFloat-                ( FloatX4#-                 (x *% sina)-                 (y *% sina)-                 (z *% sina)-                 (sqrtFloat# (0.5# +% tq) *% l2)-                )-    {-# INLINE sin #-}-    sin (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# (sinFloat# w))-        mv2 -> case sqrtFloat# mv2 of-          mv -> case cosFloat# w *% sinhFloat# mv-                                 /% mv of-            l -> QFloat-              ( FloatX4#-               (x *% l)-               (y *% l)-               (z *% l)-               (sinFloat# w *% coshFloat# mv)-              )-    {-# INLINE cos #-}-    cos (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# (cosFloat# w))-        mv2 -> case sqrtFloat# mv2 of-          mv -> case sinFloat# w *% sinhFloat# mv-                                 /% negateFloat# mv of-            l -> QFloat-              ( FloatX4#-               (x *% l)-               (y *% l)-               (z *% l)-               (cosFloat# w *% coshFloat# mv)-              )-    {-# INLINE tan #-}-    tan (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# (tanFloat# w))-        mv2 ->-          let mv = sqrtFloat# mv2-              chv = coshFloat# mv-              shv = sinhFloat# mv-              ct = cosFloat# w-              st = sinFloat# w-              cq = 1.0# /%-                  ( (ct *% ct *% chv *% chv)-                    +%-                    (st *% st *% shv *% shv)-                  )-              l = chv *% shv *% cq-                      /% mv-          in QFloat-            ( FloatX4#-             (x *% l)-             (y *% l)-             (z *% l)-             (ct *% st *% cq)-            )-    {-# INLINE sinh #-}-    sinh (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# (sinhFloat# w))-        mv2 -> case sqrtFloat# mv2 of-          mv -> case coshFloat# w *% sinFloat# mv-                                  /% mv of-            l -> QFloat-              ( FloatX4#-               (x *% l)-               (y *% l)-               (z *% l)-               (sinhFloat# w *% cosFloat# mv)-              )-    {-# INLINE cosh #-}-    cosh (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# (coshFloat# w))-        mv2 -> case sqrtFloat# mv2 of-          mv -> case sinhFloat# w *% sinFloat# mv-                                  /% mv of-            l -> QFloat-              ( FloatX4#-               (x *% l)-               (y *% l)-               (z *% l)-               (coshFloat# w *% cosFloat# mv)-              )-    {-# INLINE tanh #-}-    tanh (QFloat (FloatX4# x y z w))-      = case (x *% x) +%-             (y *% y) +%-             (z *% z) of-        0.0# -> QFloat (FloatX4# 0.0# 0.0# 0.0# (tanhFloat# w))-        mv2 ->-          let mv = sqrtFloat# mv2-              cv = cosFloat# mv-              sv = sinFloat# mv-              cht = coshFloat# w-              sht = sinhFloat# w-              cq = 1.0# /%-                  ( (cht *% cht *% cv *% cv)-                    +%-                    (sht *% sht *% sv *% sv)-                  )-              l = cv *% sv *% cq-                      /% mv-          in QFloat-            ( FloatX4#-             (x *% l)-             (y *% l)-             (z *% l)-             (cht *% sht *% cq)-            )-    {-# INLINE asin #-}-    asin q = -i * log (i*q + sqrt (1 - q*q))-        where-          i = case signum . im $ q of-                0 -> QFloat (FloatX4# 1.0# 0.0# 0.0# 0.0#)-                i' -> i'-    {-# INLINE acos #-}-    acos q = pi/2 - asin q-    {-# INLINE atan #-}-    atan q@(QFloat (FloatX4# _ _ _ w))-      = if square imq == 0-        then QFloat (FloatX4# 0.0# 0.0# 0.0# (atanFloat# w))-        else i / 2 * log ( (i + q) / (i - q) )-      where-        i = signum imq-        imq = im q-    {-# INLINE asinh #-}-    asinh q = log (q + sqrt (q*q + 1))-    {-# INLINE acosh #-}-    acosh q = log (q + sqrt (q*q - 1))-    {-# INLINE atanh #-}-    atanh q = 0.5 * log ((1+q)/(1-q))------------------------------------------------------------------------------- Eq-----------------------------------------------------------------------------instance Eq QFloat where-    {-# INLINE (==) #-}-    QFloat a == QFloat b = a == b-    {-# INLINE (/=) #-}-    QFloat a /= QFloat b = a /= b--------------------------------------------------------------------------------- Show-----------------------------------------------------------------------------instance Show QFloat where-    show (QFloat (FloatX4# x y z w)) =-        show (F# w) ++ ss x ++ "i"-                    ++ ss y ++ "j"-                    ++ ss z ++ "k"-      where-        ss a# = case F# a# of-          a -> if a >= 0 then " + " ++ show a-                         else " - " ++ show (negate a)