Expr.hs

module Calculator.Prim.Expr where

--------------------------------------------------------------------------------

import           Calculator.Prim.Base (Number)

--------------------------------------------------------------------------------

type Bindings = ( [(String, Number)]
                , [(String, Number -> Number)] )

addVar :: (String, Number) -> Bindings -> Bindings
addVar v (vs, fs) = (v:vs, fs)

addFun :: (String, Number -> Number) -> Bindings -> Bindings
addFun f (vs, fs) = (vs, f:fs)

--------------------------------------------------------------------------------

data Expr = Function String Expr
          | Constant Number
          | UnOp Operator Expr
          | BinOp (Expr, [(Operator, Expr)])
          | Variable String
          | Message [String]

data Operator = UnaryOp  (Number -> Number)
              | BinaryOp (Number -> Number -> Number)

--------------------------------------------------------------------------------

binaryOps :: [(Char, Operator)]
binaryOps = [ ('+', BinaryOp (+))
            , ('-', BinaryOp (-))
            , ('*', BinaryOp (*))
            , ('/', BinaryOp (/))
            , ('^', BinaryOp (**))
            ]

dispatch ::  [(String, Number -> Number)]
dispatch = [ ("sin", sin)
           , ("cos", cos)
           , ("tan", tan)
           , ("asin", asin)
           , ("acos", acos)
           , ("atan", atan)
           , ("sinh", sinh)
           , ("cosh", cosh)
           , ("tanh", tanh)
           , ("exp", exp)
           , ("log", log)
           , ("log10", logBase 10)
           , ("sqrt", sqrt)
           , ("ceil", fromInteger . ceiling)
           , ("floor", fromInteger . floor)
           , ("abs", abs)
           ]

--------------------------------------------------------------------------------

constEq :: Expr -> Expr -> Bool
constEq (Constant x) (Constant y) = x == y
constEq _ _                       = False

--------------------------------------------------------------------------------

defVars :: [(String, Number)]
defVars = [ ("pi", pi)
          , ("e", exp 1)
          ]

defBinds :: Bindings
defBinds = (defVars, dispatch)

--------------------------------------------------------------------------------

fromConst :: Expr -> Number
fromConst (Constant v)   = v
fromConst (Function _ _) = error "fromConst Function"
fromConst (UnOp _ _)     = error "fromConst UnOp"
fromConst (BinOp _)      = error "fromConst BinOp"
fromConst (Variable _)   = error "fromConst Variable"
fromConst (Message _)    = error "fromConst Message"

--------------------------------------------------------------------------------

isConst :: Expr -> Bool
isConst (Constant _) = True
isConst _            = False

--------------------------------------------------------------------------------

joinMessage :: Expr -> Expr -> Expr
joinMessage (Message e1) (Message e2) = Message (e1 ++ e2)
joinMessage _ _ = error "joinError used on non-error Expr"

--------------------------------------------------------------------------------