content: -- Copyright 2023 Lennart Augustsson
  -- See LICENSE file for full license.
  module Data.Integer_Type(module Data.Integer_Type) where
  import qualified Prelude()              -- do not import Prelude
  import Primitives
  import {-# SOURCE #-} Control.Error
  import Data.Bool_Type
  import Data.List_Type
  
  --
  -- The Integer is stored in sign-magnitude format with digits in base maxD (2^32)
  -- It has the following invariants:
  --  * each digit is >= 0 and < maxD
  --  * least significant digits first, most significant last
  --  * no trailing 0s in the digits
  --  * 0 is positive
  
  data Integer = I Sign [Digit] deriving ()
  
  data Sign = Plus | Minus deriving ()
  
  type Digit = Word
  
  maxD :: Digit
  maxD = 1 `primWordShl` shiftD
  
  shiftD :: Int
  shiftD = _wordSize `primIntShr` 1 -- this is used so multiplication of two digits doesn't overflow a Word
  
  quotMaxD :: Digit -> Digit
  quotMaxD d = d `primWordShr` shiftD
  
  remMaxD :: Digit -> Digit
  remMaxD d = d `primWordAnd` (maxD `primWordSub` 1)
  
  -- Sadly, we also need a bunch of functions.
  
  _intToInteger :: Int -> Integer
  _intToInteger i
    | i `primIntEQ` 0 = I Plus []
    | i `primIntGE` 0 = f Plus (primIntToWord i)
    | True            = f Minus (primIntToWord (0 `primIntSub` i))
    where
      f sign i =
        let
          high = quotMaxD i
          low = remMaxD i
        in if high `primWordEQ` 0 then I sign [low] else I sign [low, high]
  
  _integerToInt :: Integer -> Int
  _integerToInt x = primWordToInt (_integerToWord x)
  
  _wordToInteger :: Word -> Integer
  _wordToInteger i
    | i    `primWordEQ` 0 = I Plus []
    | high `primWordEQ` 0 = I Plus [low]
    | True                = I Plus [low, high]
    where
      high = quotMaxD i
      low = remMaxD i
  
  _integerToWord :: Integer -> Word
  _integerToWord (I sign ds) =
    case sign of
      Plus  -> i
      Minus -> 0 `primWordSub` i
    where
      i =
        case ds of
          []          -> 0 :: Word
          [d1]        -> d1
          d1 : d2 : _ -> d1 `primWordAdd` (d2 `primWordShl` shiftD)
  
  _integerToWord64 :: Integer -> Word64
  _integerToWord64 (I sign ds) =
    case sign of
      Plus  -> i
      Minus -> 0 `primWord64Sub` i
    where
      xadd = primWord64Add
      xmul x = primWord64Shl x shiftD
      conv [] = []
      conv (x:xs) = primWordToWord64 x : conv xs
      i =
        case conv ds of
          []            -> 0 :: Word64
          [d1]          -> d1
          -- XXX should really depend of the width of a digit
          [d1, d2]      -> xmul                                  d2  `xadd` d1
          [d1, d2, d3]  -> xmul (xmul                 d3  `xadd` d2) `xadd` d1
          d1:d2:d3:d4:_ -> xmul (xmul (xmul d4 `xadd` d3) `xadd` d2) `xadd` d1
  
  _word64ToInteger :: Word64 -> Integer
  _word64ToInteger w = I Plus (conv w)
    where conv i | primWord64EQ i 0 = []
                 | True = primWord64ToWord (primWord64Rem i base) : conv (primWord64Quot i base)
          base = primWordToWord64 maxD
  
  _integerToInt64 :: Integer -> Int64
  _integerToInt64 x = primWord64ToInt64 (_integerToWord64 x)
  
  _int64ToInteger :: Int64 -> Integer
  _int64ToInteger i
    | i `primInt64EQ` 0 = I Plus []
    | i `primInt64GE` 0 = _word64ToInteger (primInt64ToWord64 i)
    | True              = I Minus ds
      where I _ ds = _word64ToInteger (primInt64ToWord64 (0 `primInt64Sub` i))
  
  _integerToFloat :: Integer -> Float
  _integerToFloat (I sign ds) = sgn (loop ds)
    where
      loop [] = 0.0 :: Float
      loop (d : ds) = primFloatFromInt (primWordToInt d) `primFloatAdd` (primFloatFromInt (primWordToInt maxD) `primFloatMul` loop ds)
      sgn x =
        case sign of
          Plus  -> x
          Minus -> primFloatNeg x
  
  _integerToDouble :: Integer -> Double
  _integerToDouble (I sign ds) = sgn (loop ds)
    where
      loop [] = 0.0 :: Double
      loop (d : ds) = primDoubleFromInt (primWordToInt d) `primDoubleAdd` (primDoubleFromInt (primWordToInt maxD) `primDoubleMul` loop ds)
      sgn x =
        case sign of
          Plus  -> x
          Minus -> primDoubleNeg x
  