content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE StandaloneDeriving #-}
  
  
  module Numerical.Array.Layout.Dense(
    DenseLayout(..)
    ,Locality(..)
    ,Format(..)
    ,Row
    ,Column
    ,Direct
    ,module Numerical.Array.Layout.Base
     ) where
  
  
  
  import Numerical.Nat
  import Control.Applicative
  import Numerical.Array.Locality
  import Numerical.Array.Layout.Base
  import Numerical.Array.Shape as S
  import Data.Data(Data,Typeable)
  
  
  --import Data.Traversable (Traversable)
  
  import Control.NumericalMonad.State.Strict
  
  import qualified Data.Foldable as F
  import Data.Traversable
  
  import Prelude hiding (foldr,foldl,map,scanl,scanr,scanl1,scanr1)
  
  
  data Direct
  
  data Row
  
  
  data Column
  
  
  {-
  one important gotcha about shape is that for many formats,
  the Shape is the (fmap (+1)) of the largestIndex,
  often, but perhaps not always.
  
  -}
  
  {-
  
  need to figure out how to support symmetric and hermitian and triangular
  and banded matrices
  
  -}
  
  
  --class Layout form rank => DenseLayout  form  (rank :: Nat) | form -> rank  where
    {-
    empty class instances for all the dense Layouts
    -}
  
  type instance LayoutLogicalFormat (Format Direct  cont ('S 'Z ) rep  )
       = Format Direct 'Contiguous ('S 'Z) rep
  
  -- | @'Format' 'Direct' 'Contiguous' ('S' 'Z')@ is a 1dim array 'Layout' with unit stride
  data instance Format  Direct 'Contiguous ('S 'Z) rep  =
      FormatDirectContiguous {
          logicalShapeDirectContiguous :: {-#UNPACK#-} !Int }
      deriving (Show,Eq,Data)
  
  -- | @'Format' 'Direct' 'Strided'  ('S' 'Z')@ is a 1dim array 'Layout' with a regular stride >= 1
  data instance Format  Direct 'Strided ('S 'Z) rep  =
      FormatDirectStrided {
          logicalShapeDirectStrided :: {-#UNPACK#-}!Int
          ,logicalStrideDirectStrided:: {-#UNPACK#-}!Int}
      --deriving (Show,Eq,Data)
  
  type instance LayoutLogicalFormat (Format Row  cont n rep  )
       = Format Row 'Contiguous n rep
  
  -- | @'Format'  'Row'  'Contiguous' n@ is a rank n Array
  data instance  Format  Row  'Contiguous n rep   =
      FormatRowContiguous {
          boundsFormRow :: !(Shape n Int)}
      --deriving (Show,Eq,Data)
  
  data instance  Format  Row  'Strided n rep  =
      FormatRowStrided
          {boundsFormRowStrided:: !(Shape n Int)
          ,strideFormRowStrided:: !(Shape n Int)}
      --deriving (Show,Eq,Data)
  
  data instance  Format  Row  'InnerContiguous n rep  =
      FormatRowInnerContiguous {
          boundsFormRowInnerContig :: !(Shape n Int)
          ,strideFormRowInnerContig:: !(Shape n Int)}
      --deriving (Show,Eq,Data)
  
  type instance LayoutLogicalFormat (Format Column  cont n rep  )
       = Format Column 'Contiguous n rep
  
  data instance  Format  Column 'Contiguous n  rep =
      FormatColumnContiguous {
        boundsColumnContig :: !(Shape n Int)}
      --deriving (Show,Eq,Data)
  --deriving instance (Data (Shape n Int),Typeable n,Typeable rep) =>
  
  data instance  Format Column 'InnerContiguous n rep  =
      FormatColumnInnerContiguous {
          boundsColumnInnerContig :: !(Shape n Int)
          ,strideFormColumnInnerContig:: !(Shape n Int)
        }
  
  deriving instance Show (Shape n Int) => Show (Format Column 'InnerContiguous n rep)
  deriving instance (Data (Shape n Int),Typeable n,Typeable rep) =>Data (Format Column 'InnerContiguous n rep)
      --deriving (Show,Eq,Data)
  
  data instance  Format Column 'Strided n rep  =
      FormatColumnStrided {
        boundsColumnStrided :: !(Shape n Int)
        ,strideFormColumnStrided:: !(Shape n Int)}
  deriving instance Show (Shape n Int) => Show (Format Column 'Strided n rep)
  --deriving instance (Eq (Shape n Int)) => Eq (Format Column Strided n rep)
  deriving instance (Data (Shape n Int),Typeable n,Typeable rep) => Data (Format Column 'Strided n rep)
      --deriving (Show,Eq,Data)
  
  
  type instance Transposed (Format Direct 'Contiguous ('S 'Z) rep) =
      Format Direct 'Contiguous ('S 'Z) rep
  type instance Transposed (Format Direct 'Strided ('S 'Z) rep ) =
     Format Direct 'Strided ('S 'Z) rep
  
  type instance  Transposed (Format Row  'Contiguous rank rep) =
    Format Column 'Contiguous rank rep
  type instance Transposed (Format Row  'InnerContiguous rank rep) =
      Format Column  'InnerContiguous rank rep
  type instance  Transposed (Format Row  'Strided rank rep) =
      Format Column  'Strided rank rep
  
  type instance Transposed (Format Column 'Contiguous rank rep)=
      Format Row 'Contiguous rank rep
  type instance Transposed (Format Column 'InnerContiguous rank rep)=
      Format Row  'InnerContiguous rank rep
  type instance  Transposed (Format Column  'Strided rank rep)=
      Format Row  'Strided rank rep
  
  
  {-
  a bunch of routines used to give various Layout operations for
  array Formats that have  DenseLayout instance
  not exported or for human use
  -}
  {-# INLINE basicAddressRangeGeneric #-}
  basicAddressRangeGeneric ::
    (Functor (Shape rank),Applicative (Shape rank),F.Foldable (Shape rank),
              DenseLayout form rank, Address~LayoutAddress form)=> form -> Maybe (Range Address)
  basicAddressRangeGeneric = \ form ->
    if  (fmap (flip (-) 1)$ basicLogicalShape form) `strictlyDominates`  pure 0
      then Just $!
         Range  (basicToDenseAddress form  $! pure 0)
                (basicToDenseAddress form $!
                    fmap (flip (-) 1) $! basicLogicalShape form)
      else Nothing
  
  {-# INLINE basicToAddressDenseGeneric #-}
  basicToAddressDenseGeneric :: (Functor (Shape rank),Applicative (Shape rank),F.Foldable (Shape rank),
      DenseLayout form rank,Address~LayoutAddress form) => form -> Shape rank Int -> Maybe Address
  basicToAddressDenseGeneric = \ form ix ->
    if (fmap (flip (-) 1)$ basicLogicalShape form) `weaklyDominates`  ix
      && ix `weaklyDominates` pure 0
      then Just $ basicToDenseAddress form ix
      else Nothing
  {-# INLINE basicToIndexDenseGeneric #-}
  basicToIndexDenseGeneric ::
    (Functor (Shape rank),F.Foldable (Shape rank),
      DenseLayout form rank,Address~LayoutAddress form) =>  form -> Address -> Shape rank Int
  basicToIndexDenseGeneric = \form addr ->
    basicToDenseIndex form addr
  
  {-# INLINE basicNextAddressDenseGeneric #-}
  basicNextAddressDenseGeneric ::
    (Functor (Shape rank),F.Foldable (Shape rank),
      DenseLayout form rank,Address~LayoutAddress form) =>  form -> Address-> Maybe Address
  basicNextAddressDenseGeneric = \ form addy ->
    case  basicAddressRange form of
      Just  (Range lo hi ) ->  if addy >= lo && addy < hi
          then Just $! basicNextDenseAddress form addy
          else Nothing
      Nothing -> Nothing
  
  {-# INLINE basicNextIndexDenseGeneric #-}
  basicNextIndexDenseGeneric :: (Functor (Shape rank),F.Foldable (Shape rank),Applicative (Shape rank),
      DenseLayout form rank,Address~LayoutAddress form)  =>
      form -> Shape rank Int -> Maybe Address ->Maybe (Shape rank Int,Address)
  basicNextIndexDenseGeneric = \form ix _  ->
    if (fmap (flip (-) 1)$ basicLogicalShape form) `strictlyDominates`  ix
        && ix `weaklyDominates` pure 0
      then
        Just $! basicNextDenseIndex form ix
      else
        Nothing
  
  
  
  {- | note that basicAffineAddressShiftGeneric may be suboptimal,
  need to investigate what the core looks like
  also TODO needs tests
  -}
  {-# INLINE basicAffineAddressShiftDenseGeneric #-}
  basicAffineAddressShiftDenseGeneric :: (DenseLayout form rank
    ,DenseLayout (LayoutLogicalFormat form) rank
    ,Address~ LayoutAddress (LayoutLogicalFormat form))
    => form -> Address -> Int -> Maybe Address
  basicAffineAddressShiftDenseGeneric form  = \ addy shift ->
    let newForm = basicLogicalForm form in
     do
      nativeIndex <- return $ basicToDenseIndex form addy
      popBaseAddress <- return $   basicToDenseAddress newForm nativeIndex
      rng <- basicAddressRange newForm
      candidateAddress <- return $ popBaseAddress + Address shift
      if (getConst $ rangeMin ( Const) rng) <= candidateAddress
          && candidateAddress  <= (getConst $ rangeMax ( Const) rng)
        then return $ basicToDenseAddress  form $ basicToDenseIndex newForm candidateAddress
        else Nothing
  
  
  
  
  -----
  -----
  -----
  
  
  type instance LayoutAddress (Format Direct 'Contiguous ('S 'Z) rep) = Address
  type instance LayoutLogicalFormat  (Format Direct 'Contiguous ('S 'Z) rep) = Format Direct 'Contiguous ('S 'Z) rep
  instance Layout (Format Direct 'Contiguous ('S 'Z) rep)  ('S 'Z)  where
  
  
      {-# INLINE basicLogicalShape #-}
      basicLogicalShape = \ x -> (logicalShapeDirectContiguous x) :* Nil
  
      basicLogicalForm = id
  
      transposedLayout = id
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  (l:* _) (r:* _) -> compare l r
  
      basicAddressRange =  basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
  
      basicNextAddress = basicNextAddressDenseGeneric
  
      basicNextIndex = basicNextIndexDenseGeneric
  
  
      basicAddressPopCount = \ _   (Range (Address lo) (Address hi )) ->
        if  hi >= lo then hi - lo
          else error $ "for basicAddressPopCount requires address obey hi >= lo, given: "
            ++ show hi ++ " "  ++ show lo
        -- FIX me, add the range error checking
        -- in the style of the Sparse instances
  
  
      basicAddressAsInt = \ _ (Address a) -> a
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  type instance LayoutAddress (Format Direct 'Strided ('S 'Z) rep) = Address
  
  instance  Layout (Format Direct 'Strided ('S 'Z) rep)  ('S 'Z)  where
  
      {-# INLINE basicLogicalShape #-}
      basicLogicalShape = \x -> (logicalShapeDirectStrided x) :* Nil
  
      transposedLayout = id
  
      basicLogicalForm =  (\  (n :* Nil ) ->  FormatDirectContiguous n) . basicLogicalShape
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  (l:* _) (r:* _) -> compare l r
  
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress =  basicNextAddressDenseGeneric
  
      basicNextIndex =  basicNextIndexDenseGeneric
  
      basicAddressPopCount = \form@(FormatDirectStrided size _ ) (Range loA hiA)->
        let newForm = (FormatDirectContiguous size)
          in
            basicAddressPopCount  newForm
              (Range (basicToDenseAddress newForm $ basicToDenseIndex form loA)
                   (basicToDenseAddress newForm $ basicToDenseIndex form hiA) )
  
      basicAddressAsInt = \ _ (Address a) -> a
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  
  -- one type family instance for all the rows
  type instance LayoutAddress (Format Row locality    rank rep) = Address
  
  instance   (Applicative (Shape rank), Traversable (Shape rank))
      =>  Layout (Format Row  'Contiguous rank rep) rank where
  
      transposedLayout = \(FormatRowContiguous shp) -> FormatColumnContiguous $ reverseShape shp
  
      {-# INLINE basicLogicalShape #-}
      basicLogicalShape =  boundsFormRow
  
      basicLogicalForm = id
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  ls rs -> foldl majorCompareLeftToRight EQ  $ S.map2 compare ls rs
  
      basicAddressPopCount = \ _   (Range (Address lo) (Address hi )) -> hi - lo
        -- FIX me, add the range error checking
        -- in the style of the Sparse instances
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress =  basicNextAddressDenseGeneric
  
      basicNextIndex =  basicNextIndexDenseGeneric
  
      basicAddressAsInt = \ _ (Address a) -> a
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  
  
  instance   (Applicative (Shape rank), Traversable (Shape rank))
    =>  Layout (Format Row  'InnerContiguous rank rep)  rank  where
  
      {-# INLINE basicLogicalShape  #-}
      basicLogicalShape = boundsFormRowInnerContig
  
      basicLogicalForm form = FormatRowContiguous $ basicLogicalShape form
  
      transposedLayout = \(FormatRowInnerContiguous shp stride) ->
          FormatColumnInnerContiguous  (reverseShape shp)  (reverseShape stride)
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  ls rs ->
        foldl majorCompareLeftToRight EQ  $ S.map2 compare ls rs
  
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress =  basicNextAddressDenseGeneric
  
      basicNextIndex =  basicNextIndexDenseGeneric
  
      basicAddressPopCount = \form@(FormatRowInnerContiguous size _) (Range loA hiA)->
        let newForm = (FormatRowContiguous size)
          in
            basicAddressPopCount  newForm
              (Range (basicToDenseAddress newForm $ basicToDenseIndex form loA)
                   (basicToDenseAddress newForm $ basicToDenseIndex form hiA) )
  
      basicAddressAsInt = \ _ (Address a) -> a
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  
  
  instance  (Applicative (Shape rank),Traversable (Shape rank))
    =>  Layout (Format Row 'Strided rank rep) rank  where
  
      {-# INLINE basicLogicalShape  #-}
      basicLogicalShape =  boundsFormRowStrided
  
      basicLogicalForm form = FormatRowContiguous $ basicLogicalShape form
  
      transposedLayout = \(FormatRowStrided shp stride) ->
          FormatColumnStrided  (reverseShape shp)  (reverseShape stride)
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  ls rs ->
          foldl majorCompareLeftToRight EQ  $ S.map2 compare ls rs
  
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress =  basicNextAddressDenseGeneric
  
      basicNextIndex =  basicNextIndexDenseGeneric
  
      basicAddressPopCount = \form@(FormatRowStrided size _) (Range loA hiA)->
        let newForm = (FormatRowContiguous size)
          in
            basicAddressPopCount  newForm
              (Range (basicToDenseAddress newForm $ basicToDenseIndex form loA)
                   (basicToDenseAddress newForm $ basicToDenseIndex form hiA) )
  
      basicAddressAsInt = \ _ (Address a) -> a
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  
  type instance LayoutAddress (Format Column locality    rank rep) = Address
  instance  (Applicative (Shape rank), Traversable (Shape rank))
    =>  Layout (Format Column 'Contiguous rank rep)  rank where
  
      {-# INLINE basicLogicalShape  #-}
      basicLogicalShape =  boundsColumnContig
  
      basicLogicalForm = id
  
      transposedLayout = \(FormatColumnContiguous shp)-> FormatRowContiguous $ reverseShape shp
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  ls rs -> foldr majorCompareRightToLeft EQ  $ S.map2 compare ls rs
  
      basicAddressPopCount = \ _   (Range (Address lo) (Address hi )) ->
          if hi >= lo then hi - lo
              else  error  $ "for basicAddressPopCount, require address hi >= lo, given: "
                ++ show hi ++ " " ++ show lo
        -- FIX me, add the range error checking
        -- in the style of the Sparse instances
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress =  basicNextAddressDenseGeneric
  
      basicNextIndex =  basicNextIndexDenseGeneric
  
      basicAddressAsInt = \ _ (Address a) -> a
  
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  
  instance  (Applicative (Shape rank), Traversable (Shape rank))
    => Layout (Format Column 'InnerContiguous rank rep) rank  where
  
  
      {-# INLINE basicLogicalShape  #-}
      basicLogicalShape =  boundsColumnInnerContig
  
      basicLogicalForm form = FormatColumnContiguous $ basicLogicalShape form
  
      transposedLayout = \(FormatColumnInnerContiguous shp stride)->
           FormatRowInnerContiguous (reverseShape shp) (reverseShape stride)
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  ls rs -> foldr majorCompareRightToLeft EQ  $ S.map2 compare ls rs
  
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress=  basicNextAddressDenseGeneric
  
      basicNextIndex=  basicNextIndexDenseGeneric
  
      basicAddressPopCount = \form@(FormatColumnInnerContiguous size _) (Range loA hiA)->
        let newForm = (FormatColumnContiguous size)
          in
            basicAddressPopCount  newForm
              (Range (basicToDenseAddress newForm $ basicToDenseIndex form loA)
                   (basicToDenseAddress newForm $ basicToDenseIndex form hiA) )
  
      basicAddressAsInt = \ _ (Address a) -> a
   -- strideRow :: Shape rank Int,
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  instance   (Applicative (Shape rank), Traversable (Shape rank))
    => Layout (Format Column 'Strided rank rep) rank where
  
      {-# INLINE basicLogicalShape  #-}
      basicLogicalShape = boundsColumnStrided
  
      basicLogicalForm form = FormatColumnContiguous $ basicLogicalShape form
  
      transposedLayout = \(FormatColumnStrided shp stride)->
           FormatRowStrided (reverseShape shp) (reverseShape stride)
  
      {-# INLINE basicCompareIndex #-}
      basicCompareIndex = \ _  ls rs -> foldr majorCompareRightToLeft EQ $ S.map2 compare ls rs
  
      basicAddressRange = basicAddressRangeGeneric
  
      basicToAddress = basicToAddressDenseGeneric
  
      basicToIndex = basicToIndexDenseGeneric
  
      basicNextAddress =  basicNextAddressDenseGeneric
  
      basicNextIndex =  basicNextIndexDenseGeneric
  
      basicAddressPopCount = \form@(FormatColumnStrided size _) (Range loA hiA)->
        let newForm = (FormatColumnContiguous size)
          in
            basicAddressPopCount  newForm
              (Range (basicToDenseAddress newForm $ basicToDenseIndex form loA)
                   (basicToDenseAddress newForm $ basicToDenseIndex form hiA) )
  
      basicAddressAsInt = \ _ (Address a) -> a
  
      basicAffineAddressShift = basicAffineAddressShiftDenseGeneric
  
      {-# INLINE basicAffineAddressShift #-}
      {-# INLINE basicAddressRange #-}
      {-# INLINE basicToAddress #-}
      {-# INLINE basicToIndex #-}
      {-# INLINE basicNextAddress #-}
      {-# INLINE basicNextIndex #-}
      {-# INLINE basicAddressPopCount #-}
  
  ----------------------
  ----------------------
  -----
  -----
  ----------------------
  ----------------------
  
  
  
  ---
  ---
  ---
  
  {-
  these are factored out versions of the
  various shared computations in both Row and Column Major
  rank n Array format computations
  
  -}
  
  {-# INLINE computeStrideShape #-}
  computeStrideShape ::
       ((Int -> State Int Int) -> Shape n Int  -> State Int (Shape n Int )) -> Shape n Int -> Shape n Int
  computeStrideShape = \trvse shp  ->
      flip evalState 1 $
                        flip  trvse shp  $
                        -- basically accumulating the product of the
                        -- dimensions
                            \ val ->
                                 do accum <- get ;
                                    put $! (val * accum) ;
                                    return accum;
  
  
  
  
  -----
  -----
  -----
  
  instance DenseLayout (Format Direct 'Contiguous ('S 'Z) rep)  ('S 'Z)  where
  
  
      --maxDenseAddress = \ (FormatDirectContiguous ix) -> Address (ix -1)
  
  
      {-#INLINE basicToDenseAddress #-}
      basicToDenseAddress   = \ (FormatDirectContiguous _) (j :* _ ) -> Address j
  
      --basicNextIndex=  undefined -- \ _ x ->  Just $! x + 1
      --note its unchecked!
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex =  \ (FormatDirectContiguous _) (Address ix)  -> (ix ) :* Nil
  
      {-# INLINE basicNextDenseAddress #-}
      basicNextDenseAddress = \ _ addr -> addr + 1
  
  
  
  
  
  instance DenseLayout (Format Direct 'Strided ('S 'Z) rep)  ('S 'Z)  where
  
  
  
  
      {-#INLINE basicToDenseAddress #-}
      basicToDenseAddress   = \ (FormatDirectStrided _ strid) (j :* Nil )->  Address (strid * j)
  
      {-# INLINE basicNextDenseAddress #-}
      basicNextDenseAddress = \ (FormatDirectStrided _ strid) addr ->  addr + Address strid
  
      {-# INLINE basicNextDenseIndex #-}
      basicNextDenseIndex =  \ form  (i:* Nil ) ->  (\ix -> (ix,basicToDenseAddress form ix)) $! (i + 1 :* Nil )
  
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex = \ (FormatDirectStrided _ stride) (Address ix)  -> (ix `div` stride ) :* Nil
  
  
  -----
  -----
  -----
  
  
  
  -- strideRow :: Shape rank Int,
  instance   (Applicative (Shape rank),F.Foldable (Shape rank), Traversable (Shape rank))  =>
      DenseLayout (Format Row  'Contiguous rank rep) rank where
  
  {-
  TODO  AUDIT
  
  -}
      {-# INLINE basicToDenseAddress #-}
      --basicToAddress = \rs tup -> let !strider =takePrefix $! S.scanr (*) 1 (boundsFormRow rs)
      basicToDenseAddress = \rs tup ->
            let !strider =  computeStrideShape traverse (boundsFormRow rs)
                    in Address $! S.foldl'  (+) 0 $! map2 (*) strider tup
  
      {-# INLINE basicNextDenseAddress #-}
      basicNextDenseAddress = \_ addr -> addr + 1
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex  =   \ rs (Address ix) ->
          let !striderShape  = computeStrideShape traverse (boundsFormRow rs)
  
              in
                 flip evalState ix $
                    flip (S.backwards traverse)  striderShape $
                    -- want to start from largest stride (which is on the right)
                        \ currentStride ->
                               do remainderIx <- get ;
                                  let (!qt,!rm)= quotRem remainderIx currentStride
                                  put  $! rm
                                  return  qt;
  
  
  
  
  -----
  -----
  
  -- strideRow :: Shape rank Int,
  instance   (Applicative (Shape rank),F.Foldable (Shape rank), Traversable (Shape rank))
    => DenseLayout (Format Row  'InnerContiguous rank rep) rank  where
  
  
      {-# INLINE basicToDenseAddress #-}
      basicToDenseAddress = \rs tup ->
                         Address $! S.foldl'  (+) 0 $!
                           map2 (*) (strideFormRowInnerContig rs ) tup
  
      {-# INLINE basicNextDenseIndex #-}
      basicNextDenseIndex = \ form@(FormatRowInnerContiguous shape _) ix ->
          --S.map snd $!
        (\index -> (index,basicToDenseAddress form  index)) $!
          flip evalState 1 $
             for   ((,) <$> ix <*> shape) $
                \(ixv ,shpv   )->
                    do  carry <-get
                        let (newCarry,modVal)=divMod (carry + ixv) shpv
                        put $! newCarry
                        return modVal
  
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex  =   \ rs (Address ix) ->   flip evalState ix $
                            flip ( S.backwards traverse)  (strideFormRowInnerContig rs ) $
                                \ currentStride ->
                                       do remainderIx <- get ;
                                          let (!qt,!rm)= quotRem remainderIx currentStride
                                          put $! rm
                                          return  qt;
  
  
  
  ---
  ---
  -- strideRow :: Shape rank Int,
  
  instance  (Applicative (Shape rank),F.Foldable (Shape rank), Traversable (Shape rank))
    => DenseLayout (Format Row 'Strided rank rep) rank  where
  
  
  
      {-# INLINE basicToDenseAddress #-}
      basicToDenseAddress = \rs tup ->   Address $!
            S.foldl'  (+) 0 $! map2 (*) (strideFormRowStrided rs ) tup
  
      {-# INLINE basicNextDenseIndex #-}
      basicNextDenseIndex = \ form@(FormatRowStrided shape _) ix ->
        (\index -> (index,basicToDenseAddress form index)) $!
          flip evalState 1 $
             for  ((,) <$> ix <*> shape) $
                \(ixv ,shpv   )->
                    do  carry <-get
                        let (newCarry,modVal)=divMod (carry + ixv) shpv
                        put $! newCarry
                        return modVal
  
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex  =   \ rs (Address ix) ->   flip evalState ix $
                            flip (S.backwards traverse ) (strideFormRowStrided rs ) $
                                \ currentStride ->
                                       do remainderIx <- get ;
                                          let (!qt,!rm)= quotRem remainderIx currentStride
                                          put $!  rm
                                          return  qt;
  
  
  
  
  -----
  -----
  -----
  
  
   -- strideRow :: Shape rank Int,
  instance  (Applicative (Shape rank),F.Foldable (Shape rank), Traversable (Shape rank))
    => DenseLayout (Format Column  'Contiguous rank rep)  rank where
  
  
  
      {-# INLINE basicToDenseAddress #-}
      basicToDenseAddress = \rs tup ->
            let !strider = computeStrideShape  (S.backwards traverse) (boundsColumnContig rs)
                                  in Address $! S.foldl'  (+) 0 $! map2 (*) strider tup
  
      {-# INLINE basicNextDenseAddress #-}
      basicNextDenseAddress = \_ addr -> addr + 1
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex  =   \ rs (Address ix) ->
              let !striderShape  =  computeStrideShape  (S.backwards traverse) (boundsColumnContig rs)
                  in
                     flip evalState ix $
                          for  striderShape $
                                \ currentStride ->
                                       do remainderIx <- get ;
                                          let (!qt,!rm)= quotRem remainderIx currentStride
                                          put $!  rm
                                          return  qt;
  
  
  
  
  
   -- strideRow :: Shape rank Int,
  instance  (Applicative (Shape rank),F.Foldable (Shape rank), Traversable (Shape rank))
    => DenseLayout (Format Column  'InnerContiguous rank rep) rank  where
  
  
      {-# INLINE basicToDenseAddress #-}
      basicToDenseAddress    =   \ form tup -> let !strider =   strideFormColumnInnerContig form
                                  in Address $! foldl' (+) 0  $! map2 (*) strider tup
      {-# INLINE basicNextDenseIndex #-}
      basicNextDenseIndex = \ form@(FormatColumnInnerContiguous shape _) ix ->
          --S.map snd $!
        (\index -> (index,basicToDenseAddress form index)) $!
          flip evalState 1 $
             flip (S.backwards traverse)  ((,) <$> ix <*> shape) $
                \(ixv ,shpv   )->
                    do  carry <-get
                        let (newCarry,modVal)=divMod (carry + ixv) shpv
                        put $! newCarry
                        return modVal
  
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex  =   \ rs (Address ix) ->   flip evalState ix $
                            flip S.traverse  (strideFormColumnInnerContig rs ) $
                                \ currentStride ->
                                       do remainderIx <- get ;
                                          let (!qt,!rm)= quotRem remainderIx currentStride
                                          put $! rm
                                          return  qt;
  
  
  
  
  instance   (Applicative (Shape rank),F.Foldable (Shape rank), Traversable (Shape rank))
    => DenseLayout (Format Column  'Strided rank rep) rank where
  
      {-# INLINE basicToDenseAddress #-}
      basicToDenseAddress    =   \ form tup -> let !strider =   strideFormColumnStrided form
                                  in Address $! foldl' (+) 0  $! map2 (*) strider tup
  
      {-# INLINE basicNextDenseIndex #-}
      basicNextDenseIndex = \ form@(FormatColumnStrided shape _) ix ->
          --S.map snd $!
        (\index -> (index,basicToDenseAddress form index)) $!
          flip evalState 1 $
             flip (S.backwards traverse)  ((,) <$> ix <*> shape) $
                \(ixv ,shpv   )->
                    do  carry <-get
                        let (newCarry,modVal)=divMod (carry + ixv) shpv
                        put $! newCarry
                        return modVal
  
  
      {-# INLINE basicToDenseIndex #-}
      basicToDenseIndex  =   \ rs (Address ix) ->   flip evalState ix $
                            flip S.traverse  (strideFormColumnStrided rs ) $
                                \ currentStride ->
                                       do remainderIx <- get ;
                                          let (!qt,!rm)= quotRem remainderIx currentStride
                                          put $! rm
                                          return  qt;
  
  
  
  
  
  
  {-
  *Numerical.Array.Layout> basicToAddress (FormColumn (2 :* 3 :* 7 :* Nil)) (0:* 2 :* 2 :* Nil)
  Address 16
  *Numerical.Array.Layout> basicToAddress (FormColumn (2 :* 3 :* 7 :* Nil)) (1:* 0 :* 0 :* Nil)
  Address 1
  *Numerical.Array.Layout> basicToAddress (FormColumn (2 :* 3 :* 7 :* Nil)) (0:* 0 :* 0 :* Nil)
  Address 0
  *Numerical.Array.Layout> basicToAddress (FormColumn (2 :* 3 :* 7 :* Nil)) (0:* 1 :* 0 :* Nil)
  Address 2
  *Numerical.Array.Layout> basicToAddress (FormColumn (2 :* 3 :* 7 :* Nil)) (0:* 0 :* 1 :* Nil)
  -}
  
  
  