content: module BinaryRandomAccessList (BinaryList) where
    import Prelude hiding (head,tail,lookup)
    import RandomAccessList
  
    data Tree a = Leaf a | Node Int (Tree a) (Tree a)
    data Digit a = Zero | One (Tree a)
    newtype BinaryList a = BL [Digit a]
  
    size (Leaf x) = 1
    size (Node w t1 t2) = w
    link t1 t2 = Node (size t1 + size t2) t1 t2
  
    consTree t [ ] = [One t]
    consTree t (Zero : ts) = One t : ts
    consTree t1 (One t2 : ts) = Zero : consTree (link t1 t2) ts
  
    unconsTree [ ] = error "empty list"
    unconsTree [One t] = (t, [ ])
    unconsTree (One t : ts) = (t, Zero : ts)
    unconsTree (Zero : ts) = (t1, One t2 : ts')
      where (Node _ t1 t2, ts') = unconsTree ts
  
    instance RandomAccessList BinaryList where
      empty = BL [ ]
      isEmpty (BL ts) = null ts
  
      cons x (BL ts) = BL (consTree (Leaf x) ts)
      head (BL ts) = let (Leaf x, _ ) = unconsTree ts in x
      tail (BL ts) = let ( _ , ts') = unconsTree ts in BL ts'
  
      lookup i (BL ts) = look i ts
        where
          look i [ ] = error "bad subscript"
          look i (Zero : ts) = look i ts
          look i (One t : ts) =
            if i < size t then lookTree i t else look (i - size t) ts
          lookTree 0 (Leaf x) = x
          lookTree i (Leaf x) = error "bad subscript"
          lookTree i (Node w t1 t2) =
            if i < w `div` 2 then lookTree i t1 else lookTree (i - w `div` 2) t2
      update i y (BL ts) = BL (upd i ts)
        where
          upd i [ ] = error "bad subscript"
          upd i (Zero : ts) = Zero : upd i ts
          upd i (One t : ts) =
            if i < size t then One (updTree i t) : ts
            else One t : upd (i - size t) ts
          updTree 0 (Leaf x) = Leaf y
          updTree i (Leaf x) = error "bad subscript"
          updTree i (Node w t1 t2) =
            if i < w `div` 2 then Node w (updTree i t1) t2
            else Node w t1 (updTree (i - w `div` 2) t2)
  