{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module:      Data.Chimera.ContinuousMapping
-- Copyright:   (c) 2017 Andrew Lelechenko
-- Licence:     BSD3
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- Helpers for continuous mappings, useful to memoize
-- functions on 'Int' (instead of 'Word' only) and
-- functions over two and three arguments.
--
-- __Example 1__
--
-- Imagine writing a program to simulate
-- <https://en.wikipedia.org/wiki/Rule_90 Rule 90>.
-- This is a cellular automaton,
-- which consists of an infinite one-dimensional line of cells,
-- each being either dead ('False') or alive ('True').
-- If two neighbours of a cell are equal,
-- it becomes dead on the next step, otherwise alive.
--
-- Usually cellular automata are modelled by a finite vector.
-- This is a bit suboptimal, because cellular automata
-- may grow in different directions over time, but with
-- a finite vector one has to define a bounding segment well beforehand.
-- Moreover, what if we are interested to explore
-- an evolution of an essentially infinite initial configuration?
--
-- It would be natural to encode an initial configuration
-- as a function 'Int' @->@ 'Bool', which takes a coordinate
-- and returns the status of the corresponding cell. Define
-- a function, which translates the automaton to the next step:
--
-- > step :: (Int -> Bool) -> (Int -> Bool)
-- > step current = \n -> current (n - 1) /= current (n + 1)
--
-- Unfortunately, iterating @step@ would be extremely slow
-- because of branching recursion. One
-- could suggest to introduce a caching layer:
--
-- > step :: (Int -> Bool) -> (Int -> Bool)
-- > step current = \n -> current' (n - 1) /= current' (n + 1)
-- >   where
-- >     current' = memoize (current . fromIntegral) . fromIntegral
--
-- Unfortunately, it would not work well,
-- because 'fromIntegral' @::@ 'Int' @->@ 'Word'
-- maps @-1@ to 'maxBound' and it would take ages to memoize
-- everything up to 'maxBound'.
-- But continuous mappings 'intToWord' and 'wordToInt' avoid this issue:
--
-- > step :: (Int -> Bool) -> (Int -> Bool)
-- > step current = \n -> current' (n - 1) /= current' (n + 1)
-- >   where
-- >     current' = memoize (current . wordToInt) . intToWord
--
-- __Example 2__
--
-- What about another famous cellular automaton:
-- <https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life Conway's Game of Life>?
-- It is two-dimensional, so its state can be represented as
-- a function 'Int' @->@ 'Int' @->@ 'Bool'. Following the approach above,
-- we would like to memoize such functions.
-- Namely, cast the state to 'Word' @->@ 'Bool', ready for memoization:
--
-- > cast :: (Int -> Int -> Bool) -> (Word -> Bool)
-- > cast f = \n -> let (x, y) = fromZCurve n in f (fromHalf x) (fromHalf y)
-- >   where
-- >     fromHalf :: HalfWord -> Int
-- >     fromHalf = wordToInt . fromIntegral @HalfWord @Word
--
-- and then back:
--
-- > uncast :: (Word -> Bool) -> (Int -> Int -> Bool)
-- > uncast g = \x y -> g (toZCurve (toHalf x) (toHalf y))
-- >   where
-- >     toHalf :: Int -> HalfWord
-- >     toHalf = fromIntegral @Word @HalfWord . intToWord
module Data.Chimera.ContinuousMapping (
  intToWord,
  wordToInt,
  HalfWord,
  toZCurve,
  fromZCurve,
  throughZCurveFix,
  ThirdWord,
  toZCurve3,
  fromZCurve3,
  throughZCurveFix3,
) where

import Data.Bifunctor
import Data.Bits
import Data.Chimera.FromIntegral
import Data.Coerce
import Data.Word

#include "MachDeps.h"

-- | Total map, which satisfies
--
-- prop> abs (intToWord x - intToWord y) <= 2 * abs (x - y)
--
-- Note that usual 'fromIntegral' @::@ 'Int' @->@ 'Word' does not
-- satisfy this inequality,
-- because it has a discontinuity between −1 and 0.
--
-- >>> map intToWord [-5..5]
-- [9,7,5,3,1,0,2,4,6,8,10]
--
-- @since 0.2.0.0
intToWord :: Int -> Word
intToWord :: Int -> Word
intToWord Int
i = (if Word
sign forall a. Eq a => a -> a -> Bool
== Word
0 then forall a. a -> a
id else forall a. Bits a => a -> a
complement) (Int -> Word
int2word Int
i) forall a. Bits a => a -> Int -> a
`shiftL` Int
1 forall a. Num a => a -> a -> a
+ Word
sign
  where
    sign :: Word
sign = Int -> Word
int2word Int
i forall a. Bits a => a -> Int -> a
`shiftR` (forall b. FiniteBits b => b -> Int
finiteBitSize Int
i forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE intToWord #-}

-- | Inverse for 'intToWord'.
--
-- >>> map wordToInt [0..10]
-- [0,-1,1,-2,2,-3,3,-4,4,-5,5]
--
-- @since 0.2.0.0
wordToInt :: Word -> Int
wordToInt :: Word -> Int
wordToInt Word
w = Word -> Int
word2int forall a b. (a -> b) -> a -> b
$ (if Word
w forall a. Bits a => a -> a -> a
.&. Word
1 forall a. Eq a => a -> a -> Bool
== Word
0 then forall a. a -> a
id else forall a. Bits a => a -> a
complement) (Word
w forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
{-# INLINE wordToInt #-}

-- | 32 bits on 64-bit architecture, 16 bits on 32-bit architecture.
--
-- To create a value of type 'HalfWord' use 'fromIntegral'.
--
-- @since 0.4.0.0
#if WORD_SIZE_IN_BITS == 64
newtype HalfWord = HalfWord Word32
  deriving newtype (HalfWord -> HalfWord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HalfWord -> HalfWord -> Bool
$c/= :: HalfWord -> HalfWord -> Bool
== :: HalfWord -> HalfWord -> Bool
$c== :: HalfWord -> HalfWord -> Bool
Eq, Eq HalfWord
HalfWord -> HalfWord -> Bool
HalfWord -> HalfWord -> Ordering
HalfWord -> HalfWord -> HalfWord
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
min :: HalfWord -> HalfWord -> HalfWord
$cmin :: HalfWord -> HalfWord -> HalfWord
max :: HalfWord -> HalfWord -> HalfWord
$cmax :: HalfWord -> HalfWord -> HalfWord
>= :: HalfWord -> HalfWord -> Bool
$c>= :: HalfWord -> HalfWord -> Bool
> :: HalfWord -> HalfWord -> Bool
$c> :: HalfWord -> HalfWord -> Bool
<= :: HalfWord -> HalfWord -> Bool
$c<= :: HalfWord -> HalfWord -> Bool
< :: HalfWord -> HalfWord -> Bool
$c< :: HalfWord -> HalfWord -> Bool
compare :: HalfWord -> HalfWord -> Ordering
$ccompare :: HalfWord -> HalfWord -> Ordering
Ord, Int -> HalfWord -> ShowS
[HalfWord] -> ShowS
HalfWord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HalfWord] -> ShowS
$cshowList :: [HalfWord] -> ShowS
show :: HalfWord -> String
$cshow :: HalfWord -> String
showsPrec :: Int -> HalfWord -> ShowS
$cshowsPrec :: Int -> HalfWord -> ShowS
Show, ReadPrec [HalfWord]
ReadPrec HalfWord
Int -> ReadS HalfWord
ReadS [HalfWord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HalfWord]
$creadListPrec :: ReadPrec [HalfWord]
readPrec :: ReadPrec HalfWord
$creadPrec :: ReadPrec HalfWord
readList :: ReadS [HalfWord]
$creadList :: ReadS [HalfWord]
readsPrec :: Int -> ReadS HalfWord
$creadsPrec :: Int -> ReadS HalfWord
Read, Eq HalfWord
HalfWord
Int -> HalfWord
HalfWord -> Bool
HalfWord -> Int
HalfWord -> Maybe Int
HalfWord -> HalfWord
HalfWord -> Int -> Bool
HalfWord -> Int -> HalfWord
HalfWord -> HalfWord -> HalfWord
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: HalfWord -> Int
$cpopCount :: HalfWord -> Int
rotateR :: HalfWord -> Int -> HalfWord
$crotateR :: HalfWord -> Int -> HalfWord
rotateL :: HalfWord -> Int -> HalfWord
$crotateL :: HalfWord -> Int -> HalfWord
unsafeShiftR :: HalfWord -> Int -> HalfWord
$cunsafeShiftR :: HalfWord -> Int -> HalfWord
shiftR :: HalfWord -> Int -> HalfWord
$cshiftR :: HalfWord -> Int -> HalfWord
unsafeShiftL :: HalfWord -> Int -> HalfWord
$cunsafeShiftL :: HalfWord -> Int -> HalfWord
shiftL :: HalfWord -> Int -> HalfWord
$cshiftL :: HalfWord -> Int -> HalfWord
isSigned :: HalfWord -> Bool
$cisSigned :: HalfWord -> Bool
bitSize :: HalfWord -> Int
$cbitSize :: HalfWord -> Int
bitSizeMaybe :: HalfWord -> Maybe Int
$cbitSizeMaybe :: HalfWord -> Maybe Int
testBit :: HalfWord -> Int -> Bool
$ctestBit :: HalfWord -> Int -> Bool
complementBit :: HalfWord -> Int -> HalfWord
$ccomplementBit :: HalfWord -> Int -> HalfWord
clearBit :: HalfWord -> Int -> HalfWord
$cclearBit :: HalfWord -> Int -> HalfWord
setBit :: HalfWord -> Int -> HalfWord
$csetBit :: HalfWord -> Int -> HalfWord
bit :: Int -> HalfWord
$cbit :: Int -> HalfWord
zeroBits :: HalfWord
$czeroBits :: HalfWord
rotate :: HalfWord -> Int -> HalfWord
$crotate :: HalfWord -> Int -> HalfWord
shift :: HalfWord -> Int -> HalfWord
$cshift :: HalfWord -> Int -> HalfWord
complement :: HalfWord -> HalfWord
$ccomplement :: HalfWord -> HalfWord
xor :: HalfWord -> HalfWord -> HalfWord
$cxor :: HalfWord -> HalfWord -> HalfWord
.|. :: HalfWord -> HalfWord -> HalfWord
$c.|. :: HalfWord -> HalfWord -> HalfWord
.&. :: HalfWord -> HalfWord -> HalfWord
$c.&. :: HalfWord -> HalfWord -> HalfWord
Bits, Bits HalfWord
HalfWord -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: HalfWord -> Int
$ccountTrailingZeros :: HalfWord -> Int
countLeadingZeros :: HalfWord -> Int
$ccountLeadingZeros :: HalfWord -> Int
finiteBitSize :: HalfWord -> Int
$cfiniteBitSize :: HalfWord -> Int
FiniteBits, HalfWord
forall a. a -> a -> Bounded a
maxBound :: HalfWord
$cmaxBound :: HalfWord
minBound :: HalfWord
$cminBound :: HalfWord
Bounded, Int -> HalfWord
HalfWord -> Int
HalfWord -> [HalfWord]
HalfWord -> HalfWord
HalfWord -> HalfWord -> [HalfWord]
HalfWord -> HalfWord -> HalfWord -> [HalfWord]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HalfWord -> HalfWord -> HalfWord -> [HalfWord]
$cenumFromThenTo :: HalfWord -> HalfWord -> HalfWord -> [HalfWord]
enumFromTo :: HalfWord -> HalfWord -> [HalfWord]
$cenumFromTo :: HalfWord -> HalfWord -> [HalfWord]
enumFromThen :: HalfWord -> HalfWord -> [HalfWord]
$cenumFromThen :: HalfWord -> HalfWord -> [HalfWord]
enumFrom :: HalfWord -> [HalfWord]
$cenumFrom :: HalfWord -> [HalfWord]
fromEnum :: HalfWord -> Int
$cfromEnum :: HalfWord -> Int
toEnum :: Int -> HalfWord
$ctoEnum :: Int -> HalfWord
pred :: HalfWord -> HalfWord
$cpred :: HalfWord -> HalfWord
succ :: HalfWord -> HalfWord
$csucc :: HalfWord -> HalfWord
Enum, Integer -> HalfWord
HalfWord -> HalfWord
HalfWord -> HalfWord -> HalfWord
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> HalfWord
$cfromInteger :: Integer -> HalfWord
signum :: HalfWord -> HalfWord
$csignum :: HalfWord -> HalfWord
abs :: HalfWord -> HalfWord
$cabs :: HalfWord -> HalfWord
negate :: HalfWord -> HalfWord
$cnegate :: HalfWord -> HalfWord
* :: HalfWord -> HalfWord -> HalfWord
$c* :: HalfWord -> HalfWord -> HalfWord
- :: HalfWord -> HalfWord -> HalfWord
$c- :: HalfWord -> HalfWord -> HalfWord
+ :: HalfWord -> HalfWord -> HalfWord
$c+ :: HalfWord -> HalfWord -> HalfWord
Num, Enum HalfWord
Real HalfWord
HalfWord -> Integer
HalfWord -> HalfWord -> (HalfWord, HalfWord)
HalfWord -> HalfWord -> HalfWord
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: HalfWord -> Integer
$ctoInteger :: HalfWord -> Integer
divMod :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
$cdivMod :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
quotRem :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
$cquotRem :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
mod :: HalfWord -> HalfWord -> HalfWord
$cmod :: HalfWord -> HalfWord -> HalfWord
div :: HalfWord -> HalfWord -> HalfWord
$cdiv :: HalfWord -> HalfWord -> HalfWord
rem :: HalfWord -> HalfWord -> HalfWord
$crem :: HalfWord -> HalfWord -> HalfWord
quot :: HalfWord -> HalfWord -> HalfWord
$cquot :: HalfWord -> HalfWord -> HalfWord
Integral, Num HalfWord
Ord HalfWord
HalfWord -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: HalfWord -> Rational
$ctoRational :: HalfWord -> Rational
Real)
#else
newtype HalfWord = HalfWord Word16
  deriving newtype (Eq, Ord, Show, Read, Bits, FiniteBits, Bounded, Enum, Num, Integral, Real)
#endif

-- | Total map from plain to line, continuous almost everywhere.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- >>> [ toZCurve x y | x <- [0..3], y <- [0..3] ]
-- [0,2,8,10,1,3,9,11,4,6,12,14,5,7,13,15]
--
-- @since 0.2.0.0
toZCurve :: HalfWord -> HalfWord -> Word
toZCurve :: HalfWord -> HalfWord -> Word
toZCurve HalfWord
x HalfWord
y = HalfWord -> Word
part1by1 HalfWord
y forall a. Bits a => a -> Int -> a
`shiftL` Int
1 forall a. Bits a => a -> a -> a
.|. HalfWord -> Word
part1by1 HalfWord
x

-- | Inverse for 'toZCurve'.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- >>> map fromZCurve [0..15]
-- [(0,0),(1,0),(0,1),(1,1),(2,0),(3,0),(2,1),(3,1),(0,2),(1,2),(0,3),(1,3),(2,2),(3,2),(2,3),(3,3)]
--
-- @since 0.2.0.0
fromZCurve :: Word -> (HalfWord, HalfWord)
fromZCurve :: Word -> (HalfWord, HalfWord)
fromZCurve Word
z = (Word -> HalfWord
compact1by1 Word
z, Word -> HalfWord
compact1by1 (Word
z forall a. Bits a => a -> Int -> a
`shiftR` Int
1))

-- | Convert a function of two 'HalfWord's to a function of one 'Word'.
contramapFromZCurve
  :: (HalfWord -> HalfWord -> a)
  -> (Word -> a)
contramapFromZCurve :: forall a. (HalfWord -> HalfWord -> a) -> Word -> a
contramapFromZCurve HalfWord -> HalfWord -> a
f = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HalfWord -> HalfWord -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (HalfWord, HalfWord)
fromZCurve

-- | Convert a function of one 'Word' to a function of two 'HalfWord's.
contramapToZCurve
  :: (Word -> a)
  -> (HalfWord -> HalfWord -> a)
contramapToZCurve :: forall a. (Word -> a) -> HalfWord -> HalfWord -> a
contramapToZCurve Word -> a
f = (Word -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. HalfWord -> HalfWord -> Word
toZCurve

-- | For an input function @f@ return function @g@ such that
-- 'Data.Function.fix' @f@ = ('Data.Function.fix' @g@ '.') '.' 'toZCurve'.
--
-- @since 0.4.0.0
throughZCurveFix
  :: ((HalfWord -> HalfWord -> a) -> (HalfWord -> HalfWord -> a))
  -> (Word -> a)
  -> (Word -> a)
throughZCurveFix :: forall a.
((HalfWord -> HalfWord -> a) -> HalfWord -> HalfWord -> a)
-> (Word -> a) -> Word -> a
throughZCurveFix (HalfWord -> HalfWord -> a) -> HalfWord -> HalfWord -> a
f = forall a. (HalfWord -> HalfWord -> a) -> Word -> a
contramapFromZCurve forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HalfWord -> HalfWord -> a) -> HalfWord -> HalfWord -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Word -> a) -> HalfWord -> HalfWord -> a
contramapToZCurve

-- | 21 bits on 64-bit architecture, 10 bits on 32-bit architecture.
--
-- To create a value of type 'ThirdWord' use 'fromIntegral'.
--
-- @since 0.4.0.0
newtype ThirdWord = ThirdWord Word32
  deriving newtype (ThirdWord -> ThirdWord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThirdWord -> ThirdWord -> Bool
$c/= :: ThirdWord -> ThirdWord -> Bool
== :: ThirdWord -> ThirdWord -> Bool
$c== :: ThirdWord -> ThirdWord -> Bool
Eq, Eq ThirdWord
ThirdWord -> ThirdWord -> Bool
ThirdWord -> ThirdWord -> Ordering
ThirdWord -> ThirdWord -> ThirdWord
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
min :: ThirdWord -> ThirdWord -> ThirdWord
$cmin :: ThirdWord -> ThirdWord -> ThirdWord
max :: ThirdWord -> ThirdWord -> ThirdWord
$cmax :: ThirdWord -> ThirdWord -> ThirdWord
>= :: ThirdWord -> ThirdWord -> Bool
$c>= :: ThirdWord -> ThirdWord -> Bool
> :: ThirdWord -> ThirdWord -> Bool
$c> :: ThirdWord -> ThirdWord -> Bool
<= :: ThirdWord -> ThirdWord -> Bool
$c<= :: ThirdWord -> ThirdWord -> Bool
< :: ThirdWord -> ThirdWord -> Bool
$c< :: ThirdWord -> ThirdWord -> Bool
compare :: ThirdWord -> ThirdWord -> Ordering
$ccompare :: ThirdWord -> ThirdWord -> Ordering
Ord, Int -> ThirdWord -> ShowS
[ThirdWord] -> ShowS
ThirdWord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThirdWord] -> ShowS
$cshowList :: [ThirdWord] -> ShowS
show :: ThirdWord -> String
$cshow :: ThirdWord -> String
showsPrec :: Int -> ThirdWord -> ShowS
$cshowsPrec :: Int -> ThirdWord -> ShowS
Show)

mkThirdWord :: Word32 -> ThirdWord
mkThirdWord :: Word32 -> ThirdWord
mkThirdWord Word32
n = ThirdWord
t
  where
    t :: ThirdWord
t = Word32 -> ThirdWord
ThirdWord (Word32
n forall a. Bits a => a -> a -> a
.&. ((Word32
1 forall a. Bits a => a -> Int -> a
`shiftL` forall b. FiniteBits b => b -> Int
finiteBitSize ThirdWord
t) forall a. Num a => a -> a -> a
- Word32
1))

instance Read ThirdWord where
  readsPrec :: Int -> ReadS ThirdWord
readsPrec = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Word32 -> ThirdWord
mkThirdWord) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => Int -> ReadS a
readsPrec

instance Bits ThirdWord where
  .&. :: ThirdWord -> ThirdWord -> ThirdWord
(.&.) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Bits a => a -> a -> a
(.&.) @Word32)
  .|. :: ThirdWord -> ThirdWord -> ThirdWord
(.|.) = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Bits a => a -> a -> a
(.|.) @Word32)
  xor :: ThirdWord -> ThirdWord -> ThirdWord
xor = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Bits a => a -> a -> a
xor @Word32)
  complement :: ThirdWord -> ThirdWord
complement (ThirdWord Word32
n) = Word32 -> ThirdWord
mkThirdWord (forall a. Bits a => a -> a
complement Word32
n)
  shift :: ThirdWord -> Int -> ThirdWord
shift (ThirdWord Word32
n) Int
k = Word32 -> ThirdWord
mkThirdWord (forall a. Bits a => a -> Int -> a
shift Word32
n Int
k)
  bitSize :: ThirdWord -> Int
bitSize = forall b. FiniteBits b => b -> Int
finiteBitSize
  bitSizeMaybe :: ThirdWord -> Maybe Int
bitSizeMaybe = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. FiniteBits b => b -> Int
finiteBitSize
  isSigned :: ThirdWord -> Bool
isSigned = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Bits a => a -> Bool
isSigned @Word32)
  testBit :: ThirdWord -> Int -> Bool
testBit = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Bits a => a -> Int -> Bool
testBit @Word32)
  bit :: Int -> ThirdWord
bit = Word32 -> ThirdWord
mkThirdWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bits a => Int -> a
bit
  popCount :: ThirdWord -> Int
popCount = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Bits a => a -> Int
popCount @Word32)

  rotate :: ThirdWord -> Int -> ThirdWord
rotate ThirdWord
t Int
k'
    | Int
k forall a. Eq a => a -> a -> Bool
== Int
0 = ThirdWord
t
    | Bool
otherwise = (ThirdWord
t forall a. Bits a => a -> Int -> a
`shiftL` Int
k) forall a. Bits a => a -> a -> a
.|. (ThirdWord
t forall a. Bits a => a -> Int -> a
`shiftR` (Int
fbs forall a. Num a => a -> a -> a
- Int
k))
    where
      fbs :: Int
fbs = forall b. FiniteBits b => b -> Int
finiteBitSize ThirdWord
t
      k :: Int
k = Int
k' forall a. Integral a => a -> a -> a
`mod` Int
fbs

instance FiniteBits ThirdWord where
  finiteBitSize :: ThirdWord -> Int
finiteBitSize = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) forall a. Integral a => a -> a -> a
`quot` Int
3

instance Bounded ThirdWord where
  minBound :: ThirdWord
minBound = Word32 -> ThirdWord
mkThirdWord forall a. Bounded a => a
minBound
  maxBound :: ThirdWord
maxBound = Word32 -> ThirdWord
mkThirdWord forall a. Bounded a => a
maxBound

instance Enum ThirdWord where
  toEnum :: Int -> ThirdWord
toEnum = Word32 -> ThirdWord
mkThirdWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum
  fromEnum :: ThirdWord -> Int
fromEnum = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Enum a => a -> Int
fromEnum @Word32)

instance Num ThirdWord where
  ThirdWord Word32
x + :: ThirdWord -> ThirdWord -> ThirdWord
+ ThirdWord Word32
y = Word32 -> ThirdWord
mkThirdWord (Word32
x forall a. Num a => a -> a -> a
+ Word32
y)
  ThirdWord Word32
x * :: ThirdWord -> ThirdWord -> ThirdWord
* ThirdWord Word32
y = Word32 -> ThirdWord
mkThirdWord (Word32
x forall a. Num a => a -> a -> a
* Word32
y)
  negate :: ThirdWord -> ThirdWord
negate (ThirdWord Word32
x) = Word32 -> ThirdWord
mkThirdWord (forall a. Num a => a -> a
negate Word32
x)
  abs :: ThirdWord -> ThirdWord
abs = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a
abs @Word32)
  signum :: ThirdWord -> ThirdWord
signum = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a
signum @Word32)
  fromInteger :: Integer -> ThirdWord
fromInteger = Word32 -> ThirdWord
mkThirdWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

instance Real ThirdWord where
  toRational :: ThirdWord -> Rational
toRational = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Real a => a -> Rational
toRational @Word32)

instance Integral ThirdWord where
  quotRem :: ThirdWord -> ThirdWord -> (ThirdWord, ThirdWord)
quotRem = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> (a, a)
quotRem @Word32)
  toInteger :: ThirdWord -> Integer
toInteger = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> Integer
toInteger @Word32)

-- | Total map from space to line, continuous almost everywhere.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- >>> [ toZCurve3 x y z | x <- [0..3], y <- [0..3], z <- [0..3] ]
-- [0,4,32,36,2,6,34,38,16,20,48,52,18,22,50,54,1,5,33,37,3,7,35,39,17,21,49,53,19,23,51,55,
-- 8,12,40,44,10,14,42,46,24,28,56,60,26,30,58,62,9,13,41,45,11,15,43,47,25,29,57,61,27,31,59,63]
--
-- @since 0.2.0.0
toZCurve3 :: ThirdWord -> ThirdWord -> ThirdWord -> Word
toZCurve3 :: ThirdWord -> ThirdWord -> ThirdWord -> Word
toZCurve3 ThirdWord
x ThirdWord
y ThirdWord
z = ThirdWord -> Word
part1by2 ThirdWord
z forall a. Bits a => a -> Int -> a
`shiftL` Int
2 forall a. Bits a => a -> a -> a
.|. ThirdWord -> Word
part1by2 ThirdWord
y forall a. Bits a => a -> Int -> a
`shiftL` Int
1 forall a. Bits a => a -> a -> a
.|. ThirdWord -> Word
part1by2 ThirdWord
x

-- | Inverse for 'toZCurve3'.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- >>> map fromZCurve3 [0..63]
-- [(0,0,0),(1,0,0),(0,1,0),(1,1,0),(0,0,1),(1,0,1),(0,1,1),(1,1,1),(2,0,0),(3,0,0),(2,1,0),(3,1,0),(2,0,1),(3,0,1),(2,1,1),(3,1,1),
--  (0,2,0),(1,2,0),(0,3,0),(1,3,0),(0,2,1),(1,2,1),(0,3,1),(1,3,1),(2,2,0),(3,2,0),(2,3,0),(3,3,0),(2,2,1),(3,2,1),(2,3,1),(3,3,1),
--  (0,0,2),(1,0,2),(0,1,2),(1,1,2),(0,0,3),(1,0,3),(0,1,3),(1,1,3),(2,0,2),(3,0,2),(2,1,2),(3,1,2),(2,0,3),(3,0,3),(2,1,3),(3,1,3),
--  (0,2,2),(1,2,2),(0,3,2),(1,3,2),(0,2,3),(1,2,3),(0,3,3),(1,3,3),(2,2,2),(3,2,2),(2,3,2),(3,3,2),(2,2,3),(3,2,3),(2,3,3),(3,3,3)]
--
-- @since 0.2.0.0
fromZCurve3 :: Word -> (ThirdWord, ThirdWord, ThirdWord)
fromZCurve3 :: Word -> (ThirdWord, ThirdWord, ThirdWord)
fromZCurve3 Word
z = (Word -> ThirdWord
compact1by2 Word
z, Word -> ThirdWord
compact1by2 (Word
z forall a. Bits a => a -> Int -> a
`shiftR` Int
1), Word -> ThirdWord
compact1by2 (Word
z forall a. Bits a => a -> Int -> a
`shiftR` Int
2))

-- | Convert a function of two 'HalfWord's to a function of one 'Word'.
contramapFromZCurve3
  :: (ThirdWord -> ThirdWord -> ThirdWord -> a)
  -> (Word -> a)
contramapFromZCurve3 :: forall a. (ThirdWord -> ThirdWord -> ThirdWord -> a) -> Word -> a
contramapFromZCurve3 ThirdWord -> ThirdWord -> ThirdWord -> a
f = forall {t} {t} {t} {t}. (t -> t -> t -> t) -> (t, t, t) -> t
uncurry3 ThirdWord -> ThirdWord -> ThirdWord -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> (ThirdWord, ThirdWord, ThirdWord)
fromZCurve3
  where
    uncurry3 :: (t -> t -> t -> t) -> (t, t, t) -> t
uncurry3 t -> t -> t -> t
func (t
a, t
b, t
c) = t -> t -> t -> t
func t
a t
b t
c

-- | Convert a function of one 'Word' to a function of two 'HalfWord's.
contramapToZCurve3
  :: (Word -> a)
  -> (ThirdWord -> ThirdWord -> ThirdWord -> a)
contramapToZCurve3 :: forall a. (Word -> a) -> ThirdWord -> ThirdWord -> ThirdWord -> a
contramapToZCurve3 Word -> a
f = ((Word -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThirdWord -> ThirdWord -> ThirdWord -> Word
toZCurve3

-- | For an input function @f@ return function @g@ such that
-- 'Data.Function.fix' @f@ = (('Data.Function.fix' @g@ '.') '.') '.' 'toZCurve3'.
--
-- @since 0.4.0.0
throughZCurveFix3
  :: ((ThirdWord -> ThirdWord -> ThirdWord -> a) -> (ThirdWord -> ThirdWord -> ThirdWord -> a))
  -> (Word -> a)
  -> (Word -> a)
throughZCurveFix3 :: forall a.
((ThirdWord -> ThirdWord -> ThirdWord -> a)
 -> ThirdWord -> ThirdWord -> ThirdWord -> a)
-> (Word -> a) -> Word -> a
throughZCurveFix3 (ThirdWord -> ThirdWord -> ThirdWord -> a)
-> ThirdWord -> ThirdWord -> ThirdWord -> a
f = forall a. (ThirdWord -> ThirdWord -> ThirdWord -> a) -> Word -> a
contramapFromZCurve3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThirdWord -> ThirdWord -> ThirdWord -> a)
-> ThirdWord -> ThirdWord -> ThirdWord -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Word -> a) -> ThirdWord -> ThirdWord -> ThirdWord -> a
contramapToZCurve3

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
part1by1 :: HalfWord -> Word
part1by1 :: HalfWord -> Word
part1by1 HalfWord
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x5 :: Word64)
  where
    x0 :: Word64
x0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral HalfWord
x forall a. Bits a => a -> a -> a
.&. Word64
0x00000000ffffffff
    x1 :: Word64
x1 = (Word64
x0 forall a. Bits a => a -> a -> a
`xor` (Word64
x0 forall a. Bits a => a -> Int -> a
`shiftL` Int
16)) forall a. Bits a => a -> a -> a
.&. Word64
0x0000ffff0000ffff
    x2 :: Word64
x2 = (Word64
x1 forall a. Bits a => a -> a -> a
`xor` (Word64
x1 forall a. Bits a => a -> Int -> a
`shiftL` Int
8)) forall a. Bits a => a -> a -> a
.&. Word64
0x00ff00ff00ff00ff
    x3 :: Word64
x3 = (Word64
x2 forall a. Bits a => a -> a -> a
`xor` (Word64
x2 forall a. Bits a => a -> Int -> a
`shiftL` Int
4)) forall a. Bits a => a -> a -> a
.&. Word64
0x0f0f0f0f0f0f0f0f
    x4 :: Word64
x4 = (Word64
x3 forall a. Bits a => a -> a -> a
`xor` (Word64
x3 forall a. Bits a => a -> Int -> a
`shiftL` Int
2)) forall a. Bits a => a -> a -> a
.&. Word64
0x3333333333333333
    x5 :: Word64
x5 = (Word64
x4 forall a. Bits a => a -> a -> a
`xor` (Word64
x4 forall a. Bits a => a -> Int -> a
`shiftL` Int
1)) forall a. Bits a => a -> a -> a
.&. Word64
0x5555555555555555

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
part1by2 :: ThirdWord -> Word
part1by2 :: ThirdWord -> Word
part1by2 ThirdWord
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x5 :: Word64)
  where
    x0 :: Word64
x0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral ThirdWord
x forall a. Bits a => a -> a -> a
.&. Word64
0x00000000ffffffff
    x1 :: Word64
x1 = (Word64
x0 forall a. Bits a => a -> a -> a
`xor` (Word64
x0 forall a. Bits a => a -> Int -> a
`shiftL` Int
32)) forall a. Bits a => a -> a -> a
.&. Word64
0xffff00000000ffff
    x2 :: Word64
x2 = (Word64
x1 forall a. Bits a => a -> a -> a
`xor` (Word64
x1 forall a. Bits a => a -> Int -> a
`shiftL` Int
16)) forall a. Bits a => a -> a -> a
.&. Word64
0x00ff0000ff0000ff
    x3 :: Word64
x3 = (Word64
x2 forall a. Bits a => a -> a -> a
`xor` (Word64
x2 forall a. Bits a => a -> Int -> a
`shiftL` Int
8)) forall a. Bits a => a -> a -> a
.&. Word64
0xf00f00f00f00f00f
    x4 :: Word64
x4 = (Word64
x3 forall a. Bits a => a -> a -> a
`xor` (Word64
x3 forall a. Bits a => a -> Int -> a
`shiftL` Int
4)) forall a. Bits a => a -> a -> a
.&. Word64
0x30c30c30c30c30c3
    x5 :: Word64
x5 = (Word64
x4 forall a. Bits a => a -> a -> a
`xor` (Word64
x4 forall a. Bits a => a -> Int -> a
`shiftL` Int
2)) forall a. Bits a => a -> a -> a
.&. Word64
0x1249249249249249

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
compact1by1 :: Word -> HalfWord
compact1by1 :: Word -> HalfWord
compact1by1 Word
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x5 :: Word64)
  where
    x0 :: Word64
x0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x forall a. Bits a => a -> a -> a
.&. Word64
0x5555555555555555
    x1 :: Word64
x1 = (Word64
x0 forall a. Bits a => a -> a -> a
`xor` (Word64
x0 forall a. Bits a => a -> Int -> a
`shiftR` Int
1)) forall a. Bits a => a -> a -> a
.&. Word64
0x3333333333333333
    x2 :: Word64
x2 = (Word64
x1 forall a. Bits a => a -> a -> a
`xor` (Word64
x1 forall a. Bits a => a -> Int -> a
`shiftR` Int
2)) forall a. Bits a => a -> a -> a
.&. Word64
0x0f0f0f0f0f0f0f0f
    x3 :: Word64
x3 = (Word64
x2 forall a. Bits a => a -> a -> a
`xor` (Word64
x2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4)) forall a. Bits a => a -> a -> a
.&. Word64
0x00ff00ff00ff00ff
    x4 :: Word64
x4 = (Word64
x3 forall a. Bits a => a -> a -> a
`xor` (Word64
x3 forall a. Bits a => a -> Int -> a
`shiftR` Int
8)) forall a. Bits a => a -> a -> a
.&. Word64
0x0000ffff0000ffff
    x5 :: Word64
x5 = (Word64
x4 forall a. Bits a => a -> a -> a
`xor` (Word64
x4 forall a. Bits a => a -> Int -> a
`shiftR` Int
16)) forall a. Bits a => a -> a -> a
.&. Word64
0x00000000ffffffff

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
compact1by2 :: Word -> ThirdWord
compact1by2 :: Word -> ThirdWord
compact1by2 Word
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x5 :: Word64)
  where
    x0 :: Word64
x0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x forall a. Bits a => a -> a -> a
.&. Word64
0x1249249249249249
    x1 :: Word64
x1 = (Word64
x0 forall a. Bits a => a -> a -> a
`xor` (Word64
x0 forall a. Bits a => a -> Int -> a
`shiftR` Int
2)) forall a. Bits a => a -> a -> a
.&. Word64
0x30c30c30c30c30c3
    x2 :: Word64
x2 = (Word64
x1 forall a. Bits a => a -> a -> a
`xor` (Word64
x1 forall a. Bits a => a -> Int -> a
`shiftR` Int
4)) forall a. Bits a => a -> a -> a
.&. Word64
0xf00f00f00f00f00f
    x3 :: Word64
x3 = (Word64
x2 forall a. Bits a => a -> a -> a
`xor` (Word64
x2 forall a. Bits a => a -> Int -> a
`shiftR` Int
8)) forall a. Bits a => a -> a -> a
.&. Word64
0x00ff0000ff0000ff
    x4 :: Word64
x4 = (Word64
x3 forall a. Bits a => a -> a -> a
`xor` (Word64
x3 forall a. Bits a => a -> Int -> a
`shiftR` Int
16)) forall a. Bits a => a -> a -> a
.&. Word64
0xffff00000000ffff
    x5 :: Word64
x5 = (Word64
x4 forall a. Bits a => a -> a -> a
`xor` (Word64
x4 forall a. Bits a => a -> Int -> a
`shiftR` Int
32)) forall a. Bits a => a -> a -> a
.&. Word64
0x00000000ffffffff