module Language.CalDims.Expr
( Expr (..)
, BinOp (..)
, UniOp (..))
where
import Language.CalDims.Types
instance Pretty BinOp where
pretty Add = " + "
pretty Sub = " - "
pretty Mul = " * "
pretty Div = " / "
pretty Exp = " ^ "
pretty LogBase = " ~ "
instance Pretty (R, Dims) where
pretty = pretty . Evaled
instance Pretty Expr where
pretty (Evaled (r, d)) = let d' = pretty d in
pretty r ++ (if null d' then "" else " " ++ d')
pretty expr@(Bin kind a b) = s1 ++ pretty kind ++ s2
where
p = priority expr
s1 = if kind == Exp then prettyP2 p a else prettyP1 p a
s2 = case (kind == Exp, isAssoc kind) of
(True, _) -> prettyP1 p b
(_, True) -> prettyP1 p b
_ -> prettyP2 p b
pretty (Uni Negate a) = "-" ++ prettyP1 P_Negate a
pretty (Uni Expot a) = oneF "exp" a
pretty (Uni Log a) = oneF "log" a
pretty (Uni Sin a) = oneF "sin" a
pretty (Uni Cos a) = oneF "cos" a
pretty (Uni Tan a) = oneF "tan" a
pretty (Uni Asin a) = oneF "asin" a
pretty (Uni Acos a) = oneF "acos" a
pretty (Uni Atan a) = oneF "atan" a
pretty (Uni Sinh a) = oneF "sinh" a
pretty (Uni Cosh a) = oneF "cosh" a
pretty (Uni Tanh a) = oneF "tanh" a
pretty (Uni Asinh a) = oneF "asinh" a
pretty (Uni Acosh a) = oneF "acosh" a
pretty (Uni Atanh a) = oneF "atanh" a
pretty (ArgRef (Arg name _ _)) = name
pretty (Call name []) = pretty name
pretty (Call name argList) = pretty name ++ " (" ++ (pretty $ head argList) ++ (unwords $ map (\x -> ", " ++ pretty x) $ tail argList) ++ ")"
priority :: Expr -> Priority
priority (Bin Add _ _) = P_Add
priority (Bin Sub _ _) = P_Add
priority (Bin Mul _ _) = P_Mul
priority (Bin Div _ _) = P_Mul
priority (Bin Exp _ _) = P_Exp
priority (Uni Negate _) = P_Negate
priority (Evaled _) = P_Mul
priority _ = P_Elementary
isAssoc :: BinOp -> Bool
isAssoc Add = True
isAssoc Mul = True
isAssoc _ = False
prettyB :: Expr -> String
prettyB a@(Evaled _) = pretty a
prettyB a@(Call _ _) = pretty a
prettyB a@(ArgRef _) = pretty a
prettyB a@(Bin _ _ _) = "(" ++ pretty a ++ ")"
prettyB a@(Uni _ _) = "(" ++ pretty a ++ ")"
prettyP1, prettyP2 :: Priority -> Expr -> String
prettyP1 = prettyP' (>)
prettyP2 = prettyP' (>=)
prettyP' :: (Priority -> Priority -> Bool) -> Priority -> Expr -> String
prettyP' f p e = if p `f` priority e then prettyB e else pretty e
oneF :: String -> Expr -> String
oneF fn e = fn ++ " (" ++ pretty e ++ ")"