Leonardo.hs

data Spine a
  = NS (NS a a (a,a,a))
  | AS (AS a a a)
  deriving (Show)

-- non-adjacent spine: list of increasing size trees, with no two trees of adjacent index
data NS a b c
  = Nil
  | NMore (NS a c (a,b,c))
  | NCons b (NS a (a,b,c) (a,c,(a,b,c)))
  deriving (Show)

-- adjacent spine: two trees of adjacent index, plus a non-adjacent tail
data AS a b c
  = ACons b c (NS a (a,c,(a,b,c)) (a,(a,b,c),(a,c,(a,b,c))))
  | AMore (AS a c (a,b,c))
  deriving (Show)

nil :: Spine a
nil = NS Nil

cons :: a -> Spine a -> Spine a
cons x (NS xs) = cons1 x xs
cons x (AS  xs) = consA NS (AS . AMore) x xs

cons1 :: a -> NS a a (a,a,a) -> Spine a
cons1 x Nil           = NS (NCons x Nil)
cons1 x (NMore xs)    = cons2 NS (AS . AMore) x xs
cons1 x (NCons ys zs) = AS (ACons x ys zs)

consA :: (NS a c (a,b,c) -> r)
      -> (AS a c (a,b,c) -> r)
      -> a -> AS a b c -> r
consA f g x (ACons xs ys zs) = cons2 (f . NMore) (g . AMore) (x,xs,ys) zs
consA f g x (AMore xs) = consA (f . NMore) (g . AMore) x xs

cons2 :: (NS a b c -> r)
      -> (AS a b c -> r)
      -> b -> NS a c (a,b,c) -> r
cons2 f _ x Nil           = f (NCons x Nil)
cons2 f _ x (NMore xs)    = f (NCons x xs)
cons2 _ g x (NCons ys zs) = g (ACons x ys zs)