module Algebra.CAS.Core where
import Language.Haskell.TH
import Algebra.CAS.Type
exp2val :: Exp -> Value
exp2val (InfixE (Just a) (VarE op) (Just b))
| op == '(+) = exp2val a + exp2val b
| op == '() = exp2val a exp2val b
| op == '(*) = exp2val a * exp2val b
| op == '(/) = exp2val a / exp2val b
| op == '(**) = exp2val a ** exp2val b
| otherwise = error "can not parse"
exp2val (AppE (VarE fun) a)
| fun == 'log = Log $ exp2val a
| fun == 'sqrt = Sqrt $ exp2val a
| fun == 'exp = Exp $ exp2val a
| fun == 'sin = Sin $ exp2val a
| fun == 'cos = Cos $ exp2val a
| fun == 'tan = Tan $ exp2val a
| fun == 'asin = Asin $ exp2val a
| fun == 'acos = Acos $ exp2val a
| fun == 'atan = Atan $ exp2val a
| fun == 'sinh = Sinh $ exp2val a
| fun == 'cosh = Cosh $ exp2val a
| fun == 'tanh = Tanh $ exp2val a
| fun == 'asinh = Asinh $ exp2val a
| fun == 'acosh = Acosh $ exp2val a
| fun == 'atanh = Atanh $ exp2val a
| fun == 'negate = Neg $ exp2val a
| otherwise = error "can not parse"
exp2val (LitE (IntegerL a)) = CI a
exp2val (LitE (RationalL a)) = C a
exp2val (VarE a) | a == 'pi = Pi
| otherwise = V a
exp2val a@_ = error $ "can not parse:" ++ show a
val2exp :: Value -> Exp
val2exp (a :+: b) = (InfixE (Just (val2exp a)) (VarE '(+)) (Just (val2exp b)))
val2exp (a :-: b) = (InfixE (Just (val2exp a)) (VarE '()) (Just (val2exp b)))
val2exp (a :*: b) = (InfixE (Just (val2exp a)) (VarE '(*)) (Just (val2exp b)))
val2exp (a :/: b) = (InfixE (Just (val2exp a)) (VarE '(/)) (Just (val2exp b)))
val2exp (a :^: b) = (InfixE (Just (val2exp a)) (VarE '(**)) (Just (val2exp b)))
val2exp (Log a) = (AppE (VarE 'log) (val2exp a))
val2exp (Sqrt a) = (AppE (VarE 'sqrt) (val2exp a))
val2exp (Exp a) = (AppE (VarE 'exp) (val2exp a))
val2exp (Cos a) = (AppE (VarE 'cos) (val2exp a))
val2exp (Tan a) = (AppE (VarE 'tan) (val2exp a))
val2exp (Asin a) = (AppE (VarE 'asin) (val2exp a))
val2exp (Acos a) = (AppE (VarE 'acos) (val2exp a))
val2exp (Atan a) = (AppE (VarE 'atan) (val2exp a))
val2exp (Sinh a) = (AppE (VarE 'sinh) (val2exp a))
val2exp (Cosh a) = (AppE (VarE 'cosh) (val2exp a))
val2exp (Tanh a) = (AppE (VarE 'tanh) (val2exp a))
val2exp (Asinh a) = (AppE (VarE 'asinh) (val2exp a))
val2exp (Acosh a) = (AppE (VarE 'acosh) (val2exp a))
val2exp (Atanh a) = (AppE (VarE 'atanh) (val2exp a))
val2exp (Neg a) = (AppE (VarE 'negate) (val2exp a))
val2exp (CI a) = LitE (IntegerL a)
val2exp (C a) = LitE (RationalL a)
val2exp Pi = VarE 'pi
val2exp (V a) = VarE $ a
val2exp a@_ = error $ "can not parse:" ++ show a
lift :: Value -> Exp
lift = val2exp
lift1 :: (Value -> Value) -> Exp -> Exp
lift1 a b = val2exp $ a (exp2val b)
lift2 :: (Value -> Value -> Value) -> Exp -> Exp -> Exp
lift2 a b c = val2exp $ a (exp2val b) (exp2val c)
lift3 :: (Value -> Value -> Value -> Value) -> Exp -> Exp -> Exp -> Exp
lift3 a b c d = val2exp $ a (exp2val b) (exp2val c) (exp2val d)