01_Elements.hs

module Elems where

import Prelude hiding (elem)

import Data.Set (Set (..))


-----------------------------------------------------------------------------
-- | 1. Reasoning about the Set of Elements in a List ----------------------- 
-----------------------------------------------------------------------------

-- | The set of `elems` of a list





{-@ measure elems :: [a] -> (Set a)
    elems ([])    = (Set_empty 0)
    elems (x:xs)  = (Set_cup (Set_sng x) (elems xs))
  @-}




-- | A few handy aliases

{-@ predicate EqElts Xs Ys    = elems Xs = elems Ys                      @-}
{-@ predicate UnElts Xs Ys Zs = elems Xs = Set_cup (elems Ys) (elems Zs) @-}

-- | Reasoning about `append` and `reverse`

{-@ append  :: xs:_ -> ys:_ -> {v:_ | UnElts v xs ys} @-}  
append [] ys     = ys
append (x:xs) ys = x : append xs ys 


{-@ reverse :: xs:_ -> {v:_ | EqElts v xs} @-}
reverse xs           = revAcc xs []
  where 
   revAcc []     acc = acc
   revAcc (x:xs) acc = revAcc xs (x:acc)



-- But, there are limitations...
   
{-@ append'  :: xs:_ -> ys:_ -> {v:_ | UnElts v xs ys} @-}  
append' xs ys = foldr (:) ys xs


-----------------------------------------------------------------------------
-- | 2. Checking for duplicates (xmonad) ------------------------------------ 
-----------------------------------------------------------------------------

-- | Is a list free of duplicates?
   
{-@ measure nodups :: [a] -> Prop
    nodups ([])   = true
    nodups (x:xs) = (not (Set_mem x (elems xs)) && nodups xs)
  @-}

-- | Weeding out duplicates.
   
{-@ nub :: xs:_ -> {v:_ | nodups v && EqElts v xs} @-}
nub xs             = go xs []
  where
    go (x:xs) l
      | x `elem` l = go xs l     
      | otherwise  = go xs (x:l) 
    go [] l        = l


{-@ elem :: x:_ -> ys:_ -> {v:Bool | Prop v <=> Set_mem x (elems ys)} @-}
elem x []     = False
elem x (y:ys) = x == y || elem x ys

-----------------------------------------------------------------------------
-- | 3. Associative Lookups ------------------------------------------------- 
-----------------------------------------------------------------------------

-- The dread "key-not-found". How can we fix it?
find key ((k,v) : kvs)
  | key == k  = v
  | otherwise = find key kvs
find _ []     = die "Key not found! Lookup failed!"


{-@ die :: {v:_ | false} -> b @-}
die x = error x


----------------------------------------------------------------------------
-- | CHEAT AREA ------------------------------------------------------------
----------------------------------------------------------------------------

{-@ predicate ValidKey K M    = Set_mem K (keys M)  @-}

{-@ measure keys  :: [(a, b)] -> (Set a)
    keys ([])     = (Set_empty 0)
    keys (kv:kvs) = (Set_cup (Set_sng (fst kv)) (keys kvs))
  @-}

-- # START ERRORS 2 (find, append')
-- # END   ERRORS 1 (append')

{-@ find :: k:_ -> {m:_ | ValidKey k m} -> _ @-}