{-# LANGUAGE FlexibleInstances #-}

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

			-- exp is right-associative
			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) ++ ")"



-- Functions

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 ++ ")"