|
definition:
|
simplifyExpr :: Eq a => AExpr a -> AExpr a
simplifyExpr = trExpr AVar ALit AComb cLet AFree AOr cCase ABranch ATyped
where
-- compression of let-declarations
cLet a ds e | ds == ds' && e == e' = if null ds' then e' else ALet a ds' e'
| otherwise = cLet a ds' e'
where
(ds', e') = cLet' [] ds
cLet' bs0 [] = (bs0, e)
cLet' bs1 (b : bs2)
| isInlineable b = (map (second replace) (bs1 ++ bs2), replace e)
| otherwise = cLet' (bs1 ++ [b]) bs2
where
isInlineable bd = isSimple bd || not (isShared bd)
isShared ((v, _), _) = count v (concatMap freeVarsDup (e : map snd ds)) > 1
replace = simplifyExpr
. updVars (\a v -> if v == fst (fst b) then snd b else AVar a v)
count x xs = length $ filter (== x) xs
isSimple ((v, a), ve) = case ve of
AVar _ x -> x /= v -- do not replace recursive bindings
-- such as let ones = 1 : ones in ones
ALit _ _ -> True
AComb _ ct _ es -> (ct == ConsCall || isPartCall ct)
&& all (curry isSimple (v, a)) es
_ -> isFailed ve
-- Compression of case expressions: When the scrutinized expression is either
-- a literal or a constructor call, the respective branch is searched for.
-- If such a branch exists, the expressions reduces to the branch's
-- right-hand-side, otherwise the expression reduces to `failed`.
-- Also removes case expressions where all branches are the same.
cCase a ct e bs | allEqual (map branchExpr bs) = branchExpr (head bs)
| otherwise = case e of
ALit a' l -> case findBranch (ALPattern a' l) bs of
Nothing -> failedExpr a
Just (_, be) -> be
AComb a' ConsCall c es -> case findBranch (APattern a' c []) bs of
Nothing -> failedExpr a
Just (xs, be) -> simplifyExpr (unfold xs es be)
_ -> if null bs then failedExpr a else ACase a ct e bs
|