church-encoding

church-encoding.hs

{-# LANGUAGE RankNTypes #-}


newtype BST k v = Roll
  { unroll :: forall r. r -> (k -> v -> r -> r -> r) -> r
  }

-- Two constructors
leave :: BST k v
leave = Roll const

node :: Ord k => k -> v -> BST k v -> BST k v -> BST k v
node k v l r = Roll $ \ d b -> b k v (unroll l d b) (unroll r d b)


lookup' :: Ord k => k -> BST k v -> Maybe v
lookup' k bst = unroll bst Nothing $ \k' v l r ->
  case compare k k' of
    EQ -> Just v
    LT -> l
    GT -> r


insert :: Ord k => k -> v -> BST k v -> BST k v
insert k v bst = unroll bst (node k v leave leave) $ \k' v' l r ->
  case compare k k' of
    GT -> node k' v' l (insert k v r)
    _ -> node k' v' (insert k v l) r



main :: IO ()
main = do
  let tree = insert 1 'c' (insert 2 'b' leave)
  let res = lookup' 2 tree
  print res