dsl_arithmetic_1_optimize.hs

optimize :: Expr -> Expr
optimize op@(Op Add ys) = optimizeOp Add (map optimize ys) 0 (+)
optimize op@(Op Mul ys)
  | not (null (dropWhile (/= cst 0) xs)) = cst 0
  | otherwise = optimizeOp Mul xs 1 (*)
  where xs = map optimize ys
optimize e = e

optimizeOp :: OpType -> [Expr] -> Int -> (Int -> Int -> Int) -> Expr
optimizeOp opType xs neutral combine =
  let (constants, vars) = partition isCst xs
      constantsVal = map (\(Cst x) -> x) constants
      sumCst = foldl' combine neutral constantsVal
  in case vars of
      [] -> cst sumCst
      [y] | sumCst == neutral -> y
      ys  | sumCst == neutral -> Op opType ys
      ys  -> Op opType (cst sumCst : ys)