UOptimize.hs

module UOptimize where
import ULambdaExpression
import qualified Data.Set as Set

data LExprA a = LIntA a Int | LDoubleA a Double | LRefA a [Char] | LAbsA a [Char] (LExprA a) | LApplyA a (LExprA a) (LExprA a) deriving Show

getAnnot :: LExprA a -> a
getAnnot (LIntA a _) = a 
getAnnot (LDoubleA a _) = a 
getAnnot (LRefA a _) = a 
getAnnot (LAbsA a _ _) = a 
getAnnot (LApplyA a _ _) = a 

stripAnnot :: LExprA a -> LExpr
stripAnnot (LIntA _ v) = LInt v
stripAnnot (LDoubleA _ v) = LDouble v
stripAnnot (LRefA _ v) = LRef v
stripAnnot (LAbsA _ k v) = LAbs k (stripAnnot v)
stripAnnot (LApplyA _ f x) = LApply (stripAnnot f) (stripAnnot x)

type FreeVarInfo = Set.Set [Char]

annotateFreeVar :: LExpr -> LExprA FreeVarInfo
annotateFreeVar l = case l of
	LInt v -> LIntA (Set.fromList []) v
	LDouble v -> LDoubleA (Set.fromList []) v
	LRef k -> LRefA (Set.fromList [k]) k
	LAbs k v -> let
		body = annotateFreeVar v
		in LAbsA (Set.delete k (getAnnot body)) k body
	LApply f x -> let
		lf = annotateFreeVar f
		lx = annotateFreeVar x
		unpruned = LApplyA (Set.union (getAnnot lf) (getAnnot lx)) lf lx 
		in case lf of
			LAbsA _ k fbody 
				| not$Set.member k (getAnnot fbody) -> fbody
				| otherwise -> unpruned
			_ -> unpruned

optimizeLExpr = stripAnnot . annotateFreeVar