alphaconvert-Set.hs

{-@ LIQUID "--no-termination" @-}
{-@ LIQUID "--short-names"    @-}
{-@ LIQUID "--fullcheck"      @-}
{-@ LIQUID "--maxparams=3"    @-}

module AlphaConvert (isAbs, subst) where

import qualified Data.Set as S

import Language.Haskell.Liquid.Prelude

freshS  :: S.Set Bndr -> Bndr
alpha   :: S.Set Bndr -> Expr -> Expr
subst   :: Expr -> Bndr -> Expr -> Expr
free    :: Expr -> S.Set Bndr


---------------------------------------------------------------------
-- | Datatype Definition --------------------------------------------
---------------------------------------------------------------------

type Bndr
  = Int

data Expr
  = Var Bndr
  | Abs Bndr Expr
  | App Expr Expr

{-@ measure fv       :: Expr -> (S.Set Bndr)
    fv (Var x)       = (Set_sng x)
    fv (Abs x e)     = (Set_dif (fv e) (Set_sng x))
    fv (App e a)     = (Set_cup (fv e) (fv a))
  @-}

{-@ measure isAbs @-}
isAbs (Var v)    = False
isAbs (Abs v e)  = True
isAbs (App e a)  = False

{-@ predicate Elem  X Ys       = Set_mem X Ys               @-}
{-@ predicate NotElem X Ys     = not (Elem X Ys)            @-}
{-@ predicate AddV E E2 X E1   = fv E = Set_cup (Set_dif (fv E2) (Set_sng X)) (fv E1) @-}
{-@ predicate EqV E1 E2        = fv E1 = fv E2                                        @-}
{-@ predicate Occ X E          = Set_mem X (fv E)                                     @-}
{-@ predicate Subst E E1 X E2  = if (Occ X E2) then (AddV E E2 X E1) else (EqV E E2)  @-}

----------------------------------------------------------------------------
-- | Part 5: Capture Avoiding Substitution ---------------------------------
----------------------------------------------------------------------------
{-@ subst :: e1:Expr -> x:Bndr -> e2:Expr -> {e:Expr | Subst e e1 x e2} @-}
----------------------------------------------------------------------------

subst e' x e@(Var y)
  | x == y                = e'
  | otherwise             = e

subst e' x (App ea eb)    = App ea' eb'
  where
    ea'                   = subst e' x ea
    eb'                   = subst e' x eb

subst e1 x e2@(Abs y e)
  | x == y                = e2
  | y `S.member` xs       = subst e1 x (alpha xs e2)
  | otherwise             = Abs y (subst e1 x e)
    where
      xs                  = free e1

----------------------------------------------------------------------------
-- | Part 4: Alpha Conversion ----------------------------------------------
----------------------------------------------------------------------------
{-@ alpha :: ys:(S.Set Bndr) -> e:{Expr | isAbs e} -> {v:Expr | EqV v e} @-}
----------------------------------------------------------------------------
alpha ys (Abs x e) = Abs x' (subst (Var x') x e)
  where
    xs             = free e
    x'             = freshS zs
    zs             = S.insert x (S.union ys xs)

alpha _  _         = liquidError "never"


----------------------------------------------------------------------------
-- | Part 3: Fresh Variables -----------------------------------------------
----------------------------------------------------------------------------
{-@ freshS :: xs:(S.Set Bndr) -> {v:Bndr | NotElem v xs} @-}
----------------------------------------------------------------------------
freshS xs = undefined


----------------------------------------------------------------------------
-- | Part 2: Free Variables ------------------------------------------------
----------------------------------------------------------------------------

----------------------------------------------------------------------------
{-@ free         :: e:Expr -> {v : S.Set Bndr | v = fv e} @-}
----------------------------------------------------------------------------
free (Var x)     = S.singleton x
free (App e e')  = S.union  (free e) (free e')
free (Abs x e)   = S.delete x (free e)