module Language.Del.Constants (propConstants, foldConstantExprs) where
import Language.Del.AST
import Language.Del.AstUtils
import Language.Del.CompileDefs
import Control.Monad
import qualified Data.Map.Strict as Map
-- Replace references to constants with the constants themselves
propConstants' :: Expr -> Expr
propConstants' (Let n v@(Number _) b) = mapexpr (replaceNames $ Map.singleton n v) b
propConstants' (Let n v@(Id _) b) = mapexpr (replaceNames $ Map.singleton n v) b
propConstants' e = e
propConstants :: Def -> Artifact Def
propConstants (Def n ret a b) = return . Def n ret a $ mapexpr propConstants' b
isNumber :: Expr -> Bool
isNumber (Number _) = True
isNumber _ = False
getNumbers :: [Expr] -> [DelNum]
getNumbers = map extract . filter isNumber
where extract (Number nt) = nt
extract _ = undefined
-- Only safe to call on expressions that are definitely constant numbers
extractNumber :: Expr -> DelNum
extractNumber (Number n) = n
extractNumber _ = undefined
liftConstExprOp :: (DelNum -> DelNum -> DelNum) -> Expr -> Expr -> Expr -> Expr
liftConstExprOp f e e1 e2 =
if isNumber e1 && isNumber e2
then Number $ f (extractNumber e1) (extractNumber e2)
else e
-- Replace arithmetic operations on constants with the result of the operation
-- itself.
collapseConstExprs' :: Expr -> Expr
-- These two partition the list into constant numbers and not-constant-numbers,
-- sum/product the constant numbers, promoting them in the meantime if
-- necessary, and then prepend that constant onto the the list of
-- non-constants.
collapseConstExprs' (Add xs) =
Add . (flip (:)) (filter (not . isNumber) xs) . Number . sum . promote . getNumbers $ xs
collapseConstExprs' (Mul xs) =
Mul . (flip (:)) (filter (not . isNumber) xs) . Number . product . promote . getNumbers $ xs
collapseConstExprs' e@(Sub e1 e2) = liftConstExprOp (-) e e1 e2
collapseConstExprs' e@(Div e1 e2) = liftConstExprOp (/) e e1 e2
collapseConstExprs' e@(Pow e1 e2) = liftConstExprOp pow e e1 e2
collapseConstExprs' e = e
collapseConstExprs :: Def -> Artifact Def
collapseConstExprs (Def n ret a b) = return . Def n ret a $ mapexpr collapseConstExprs' b
-- Remove unnecessary arithmetic
remIdent :: Integer -> ([Expr] -> Expr) -> [Expr] -> Expr
remIdent ident ctor exprs =
case (filter (\e -> case e of
Number (DelInt x) -> x /= ident
Number (DelFloat x) -> x /= fromIntegral ident
_ -> True) exprs) of
[] -> Number $ DelInt ident
[x] -> x
xs -> ctor xs
removeIdentities' :: Expr -> Expr
removeIdentities' (Add xs) = remIdent 0 Add xs
removeIdentities' (Mul xs) = remIdent 1 Mul xs
removeIdentities' (Pow _ (Number (DelInt 0))) = Number (DelInt 1)
removeIdentities' (Pow _ (Number (DelFloat 0))) = Number (DelFloat 1)
removeIdentities' e = e
removeIdentities :: Def -> Artifact Def
removeIdentities (Def n ret a b) = return . Def n ret a $ mapexpr removeIdentities' b
foldConstantExprs :: Def -> Artifact Def
-- this is not the correct way to do this; some kind of
-- iteration-until-finished is the way to go here.
foldConstantExprs = collapseConstExprs
>=> removeIdentities
>=> collapseConstExprs
>=> removeIdentities