module ArrayB (

  ArrayB, emptyArrayB, update, set, (!), listToArrayB,

  emptyArrayWithDefault

  ) where

data ArrayB a = Entry a (ArrayB a) (ArrayB a)

emptyArrayB :: ArrayB a
emptyArrayB = emptyArrayWithDefault 
               (\n -> error $ "array index " ++ show n ++ " not initialized!")

emptyArrayWithDefault :: (Int -> a) -> ArrayB a
emptyArrayWithDefault = emptyArrayWithDefaultAt 0 0

emptyArrayWithDefaultAt :: Int -> Int -> (Int -> a) -> ArrayB a
emptyArrayWithDefaultAt min off def
  = Entry (def (min+off))
          (emptyArrayWithDefaultAt (2*min+1) off def)
          (emptyArrayWithDefaultAt (2*min+1) (min+off+1) def)

update :: Int -> (a -> a) -> ArrayB a -> ArrayB a
update n f (Entry x l r)
  | n == 0    = Entry (f x) l r
  | even n    = Entry x l (update (n`div`2-1) f r)
  | otherwise = Entry x (update (n`div`2) f l) r

set :: Int -> a -> ArrayB a -> ArrayB a
set n = update n . const

(!) :: ArrayB a -> Int -> a
Entry x l r ! n
  | n == 0    = x
  | even n    = r ! (n`div`2-1)
  | otherwise = l ! (n`div`2)

listToArrayB :: [a] -> ArrayB a
listToArrayB []     = emptyArrayB
listToArrayB (x:xs) = let (ls,rs) = split xs
                       in Entry x (listToArrayB ls) (listToArrayB rs)

split :: [a] -> ([a],[a])
split []       = ([],[])
split [x]      = ([x],[])
split (x:y:zs) = let (xs,ys) = split zs in (x:xs,y:ys)