Skip to content

Instantly share code, notes, and snippets.

@deque-blog

deque-blog/dsl_arithmetic_2_optimized_operations.hs

Last active January 21, 2017 21:09
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save deque-blog/546ae1cf792372b56c073a801e467901 to your computer and use it in GitHub Desktop.
Save deque-blog/546ae1cf792372b56c073a801e467901 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
dsl_arithmetic_2_optimized_operations.hs
optimizeAdd :: ExprR Expr -> Expr
optimizeAdd op@(Op Add _) = optimizeOp op 0 (+)
optimizeAdd e = Fix e
optimizeMul :: ExprR Expr -> Expr
optimizeMul op@(Op Mul xs)
| not (null (dropWhile (/= cst 0) xs)) = cst 0
| otherwise = optimizeOp op 1 (*)
optimizeMul e = Fix e
optimizeOp :: ExprR Expr -> Int -> (Int -> Int -> Int) -> Expr
optimizeOp (Op optType xs) neutral combine =
let (constants, vars) = partition isCst xs
constantsVal = map (\(Fix (Cst x)) -> x) constants
sumCst = foldl' combine neutral constantsVal
in case vars of
[] -> cst sumCst
[y] | sumCst == neutral -> y
ys | sumCst == neutral -> Fix (Op optType ys)
ys -> Fix (Op optType (cst sumCst : ys))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment