module Exercise05 where

import Data.Bits

-- May or may not be useful: computes the logarithm base 2 (rounded down) of the given number.
-- You don't have to move this into the WETT tags if you want to use it.
log2 :: (Integral a, Num b) => a -> b
log2 = let go acc n = if n <= 1 then acc else go (acc + 1) (n `div` 2) in go 0

{-WETT-}
decompose :: [Integer] -> [Integer]
decompose ds = decomposeHelper ds (length ds - 1)
  where
    decomposeHelper :: [Integer] -> Int -> [Integer]
    decomposeHelper [] _ = []
    decomposeHelper [d] _ = reverseBinary d []
    decomposeHelper (d : ds') dim = reverseBinary d [] `merge` decomposeHelper ds' (dim - 1)
      where
        merge :: [Integer] -> [Integer] -> [Integer]
        merge = (drop 2 .) . merge'
        
        merge' :: [Integer] -> [Integer] -> [Integer]
        merge' [] ys = {-# SCC merge'_xs_empty #-} merge' [0] ys
        merge' [x] [] = {-# SCC merge'_one_x_ys_empty #-} [0, x]
        merge' [x] ys = {-# SCC merge'_xs_shorter_ys #-} merge' [x, 0] ys
        merge' (x : x' : xs) [] =
          {-# SCC merge'_ys_empty #-} [0, x + (2 * xSum)]
          where
            [0, xSum] = merge' (x' : xs) []
        merge' (x : x' : xs) [y] =
          {-# SCC merge'_one_y #-} y : newXSum : ([newElem | newElem > 0])
          where
            [0, xSum] = merge' (x' : xs) []
            newXSum = x + 2 * xSum
            newElem = newXSum * y
        merge' (x : x' : xs) (y : y' : ys) =
          {-# SCC merge'_default #-}
          newYSum : (x + partialNewXSum) : if null zs && newElem == 0 then [] else newElem : zs
          where
            newElem = (partialNewXSum * y) + (x * newYSum)
            newYSum = (ySum `shiftL` dim) + y
            partialNewXSum = 2 * xSum
            ySum : xSum : zs = merge' (x' : xs) (y' : ys)

    reverseBinary :: (Integral a, Bits a) => a -> [a] -> [a]
    reverseBinary 0 xs = reverse xs
    reverseBinary n xs = reverseBinary q (r : xs)
      where
        (q, r) = n `quotRem` 2

{-TTEW-}