-- lame.hs (April 2008)
-- Copyright Ralph Matthes, IRIT (CNRS & University of Toulouse)

data LamE a = VarE a | AppE (LamE a, LamE a) | AbsE (LamE (Maybe a))
                     | FlatE (LamE (LamE a)) deriving Show

filterSome:: [Maybe a] -> [a]
filterSome [] = []
filterSome (Nothing:l) = filterSome l
filterSome ((Just a):l) = a:(filterSome l)

flatten = foldr (++) []

efv:: LamE a -> [a]
efv (VarE a) = [a]
efv (AppE (t1,t2)) = efv t1 ++ efv t2
efv (AbsE r) = filterSome (efv r)
efv (FlatE ee) = flatten (map efv (efv ee))

--t1:: LamE a
t1 = AbsE (AppE (VarE Nothing, VarE (Just Nothing)))
t2 = VarE (Just Nothing)
t3 = AppE (AppE(VarE Nothing,VarE(Just t1)),VarE(Just t2))
t = FlatE (AbsE t3)

t' = t::LamE (Maybe(Maybe Integer))
l = efv t'

--main = print (t',l)
main = putStrLn(show t') >> 
  putStrLn("has the following list of names of free variables:") >> 
  putStrLn(show l)

-- compile with ghc lame.hs
-- interpret with hugs +98 lame.hs

maybe' f Nothing = Nothing
maybe' f (Just a) = Just (f a)
 
lamE:: (a->b) -> LamE a -> LamE b
lamE f (VarE a) = VarE (f a)
lamE f (AppE (t1,t2)) = AppE (lamE f t1, lamE f t2)
lamE f (AbsE r) = AbsE (lamE (maybe' f) r)
lamE f (FlatE ee) = FlatE (lamE (\t -> lamE (\x -> f x) t) ee)

liftE f Nothing = VarE Nothing
liftE f (Just a) = lamE Just (f a)

substE:: (a -> LamE b) -> LamE a -> LamE b
substE f (VarE a) = f a
substE f (AppE (t1,t2)) = AppE(substE f t1, substE f t2)
substE f (AbsE r) = AbsE (substE (liftE f) r)
substE f (FlatE ee) = FlatE (substE(VarE . (substE f)) ee)