{-# LANGUAGE GADTs #-}

module Data.Tensort.Utils.Types where

data TensortProps = TensortProps {TensortProps -> Int
bytesize :: Int, TensortProps -> SortAlg
subAlgorithm :: SortAlg}

--   All the data types used in the Tensort and Tensort algorithms are
--   defined here. Since these packages are only for sorting Ints currently,
--   every data type is a structure of Ints

-- | A Bit is a single element of the list to be sorted. For
--   our current purposes that means it is an Int

-- | NOTE: To Self: at this point it's likely simple enough to refactor this
--   to sort any Ord, not just Ints. Consider using the `Bit` type synonym
--   in the code, then changing this to alias `Bit` to `Ord` or `a`
type Bit = Int

-- | A Byte is a list of Bits standardized to a fixed maximum length (Bytesize)

-- | The length should be set either in or upstream of any function that uses
--   Bytes
type Byte = [Bit]

-- | An Address is a index number pointing to data stored in Memory
type Address = Int

-- | A TopBit contains a copy of the last (i.e. highest) Bit in a Byte or
--   Tensor
type TopBit = Bit

-- | A Record is an element in a Tensor's Register
--   containing an Address pointer and a TopBit value

-- | A Record's Address is an index number pointing to a Byte or Tensor in
--   the Tensor's Memory

-- | A Record's TopBit is a copy of the last (i.e. highest) Bit in the Byte or
--   Tensor that the Record references
type Record = (Address, TopBit)

-- | A Register is a list of Records allowing for easy access to data in a
--   Tensor's Memory
type Register = [Record]

-- | We use a Sortable type sort between Bits and Records

-- | In the future this may be expanded to include other data types and allow
--   for sorting other types of besides Ints.
data Sortable
  = SortBit [Bit]
  | SortRec [Record]
  deriving (Int -> Sortable -> ShowS
[Sortable] -> ShowS
Sortable -> String
(Int -> Sortable -> ShowS)
-> (Sortable -> String) -> ([Sortable] -> ShowS) -> Show Sortable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sortable -> ShowS
showsPrec :: Int -> Sortable -> ShowS
$cshow :: Sortable -> String
show :: Sortable -> String
$cshowList :: [Sortable] -> ShowS
showList :: [Sortable] -> ShowS
Show, Sortable -> Sortable -> Bool
(Sortable -> Sortable -> Bool)
-> (Sortable -> Sortable -> Bool) -> Eq Sortable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sortable -> Sortable -> Bool
== :: Sortable -> Sortable -> Bool
$c/= :: Sortable -> Sortable -> Bool
/= :: Sortable -> Sortable -> Bool
Eq, Eq Sortable
Eq Sortable =>
(Sortable -> Sortable -> Ordering)
-> (Sortable -> Sortable -> Bool)
-> (Sortable -> Sortable -> Bool)
-> (Sortable -> Sortable -> Bool)
-> (Sortable -> Sortable -> Bool)
-> (Sortable -> SortAlg)
-> (Sortable -> SortAlg)
-> Ord Sortable
Sortable -> Sortable -> Bool
Sortable -> Sortable -> Ordering
Sortable -> SortAlg
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sortable -> Sortable -> Ordering
compare :: Sortable -> Sortable -> Ordering
$c< :: Sortable -> Sortable -> Bool
< :: Sortable -> Sortable -> Bool
$c<= :: Sortable -> Sortable -> Bool
<= :: Sortable -> Sortable -> Bool
$c> :: Sortable -> Sortable -> Bool
> :: Sortable -> Sortable -> Bool
$c>= :: Sortable -> Sortable -> Bool
>= :: Sortable -> Sortable -> Bool
$cmax :: Sortable -> SortAlg
max :: Sortable -> SortAlg
$cmin :: Sortable -> SortAlg
min :: Sortable -> SortAlg
Ord)

fromSortBit :: Sortable -> [Bit]
fromSortBit :: Sortable -> [Int]
fromSortBit (SortBit [Int]
bits) = [Int]
bits
fromSortBit (SortRec [Record]
_) = String -> [Int]
forall a. HasCallStack => String -> a
error String
"This is for sorting Bits - you gave me Records"

fromSortRec :: Sortable -> [Record]
fromSortRec :: Sortable -> [Record]
fromSortRec (SortRec [Record]
recs) = [Record]
recs
fromSortRec (SortBit [Int]
_) = String -> [Record]
forall a. HasCallStack => String -> a
error String
"This is for sorting Records - you gave me Bits"

type SortAlg = Sortable -> Sortable

type SupersortProps = (SortAlg, SortAlg, SortAlg, SupersortStrat)

type SupersortStrat = (Sortable, Sortable, Sortable) -> Sortable

-- | A Memory contains the data to be sorted, either in the form of Bytes or
--   Tensors.
data Memory
  = ByteMem [Byte]
  | TensorMem [Tensor]
  deriving (Int -> Memory -> ShowS
[Memory] -> ShowS
Memory -> String
(Int -> Memory -> ShowS)
-> (Memory -> String) -> ([Memory] -> ShowS) -> Show Memory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Memory -> ShowS
showsPrec :: Int -> Memory -> ShowS
$cshow :: Memory -> String
show :: Memory -> String
$cshowList :: [Memory] -> ShowS
showList :: [Memory] -> ShowS
Show, Memory -> Memory -> Bool
(Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool) -> Eq Memory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Memory -> Memory -> Bool
== :: Memory -> Memory -> Bool
$c/= :: Memory -> Memory -> Bool
/= :: Memory -> Memory -> Bool
Eq, Eq Memory
Eq Memory =>
(Memory -> Memory -> Ordering)
-> (Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool)
-> (Memory -> Memory -> Memory)
-> (Memory -> Memory -> Memory)
-> Ord Memory
Memory -> Memory -> Bool
Memory -> Memory -> Ordering
Memory -> Memory -> Memory
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Memory -> Memory -> Ordering
compare :: Memory -> Memory -> Ordering
$c< :: Memory -> Memory -> Bool
< :: Memory -> Memory -> Bool
$c<= :: Memory -> Memory -> Bool
<= :: Memory -> Memory -> Bool
$c> :: Memory -> Memory -> Bool
> :: Memory -> Memory -> Bool
$c>= :: Memory -> Memory -> Bool
>= :: Memory -> Memory -> Bool
$cmax :: Memory -> Memory -> Memory
max :: Memory -> Memory -> Memory
$cmin :: Memory -> Memory -> Memory
min :: Memory -> Memory -> Memory
Ord)

-- | A Tensor contains data to be sorted in a structure allowing for
--   easy access. It consists of a Register and its Memory.

-- | The Memory is a list of the Bytes or other Tensors that this Tensor
--   contains.

-- | The Register is a list of Records referencing the top Bits in Memory.
type Tensor = (Register, Memory)

-- | A TensorStack is a top-level Tensor. In the final stages of Tensort, the
--   number of TensorStacks will equal the bytesize, but before that time there
--   are expected to be many more TensorStacks.
type TensorStack = Tensor

fromJust :: Maybe a -> a
fromJust :: forall a. Maybe a -> a
fromJust (Just a
x) = a
x
fromJust Maybe a
Nothing = String -> a
forall a. HasCallStack => String -> a
error String
"fromJust: Nothing"