{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Language.Egison.Primitives.Arith
( primitiveArithFunctions
) where
import Language.Egison.Data
import Language.Egison.Math
import Language.Egison.Primitives.Utils
primitiveArithFunctions :: [(String, EgisonValue)]
primitiveArithFunctions :: [(String, EgisonValue)]
primitiveArithFunctions =
((String, String -> PrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> PrimitiveFunc)] -> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> PrimitiveFunc
fn) -> (String
name, PrimitiveFunc -> EgisonValue
PrimitiveFunc (String -> PrimitiveFunc
fn String
name))) [(String, String -> PrimitiveFunc)]
strictPrimitives
strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives =
[ (String
"b.+", String -> PrimitiveFunc
plus)
, (String
"b.-", String -> PrimitiveFunc
minus)
, (String
"b.*", String -> PrimitiveFunc
multiply)
, (String
"b./", String -> PrimitiveFunc
divide)
, (String
"f.+", (Double -> Double -> Double) -> String -> PrimitiveFunc
floatBinaryOp Double -> Double -> Double
forall a. Num a => a -> a -> a
(+))
, (String
"f.-", (Double -> Double -> Double) -> String -> PrimitiveFunc
floatBinaryOp (-))
, (String
"f.*", (Double -> Double -> Double) -> String -> PrimitiveFunc
floatBinaryOp Double -> Double -> Double
forall a. Num a => a -> a -> a
(*))
, (String
"f./", (Double -> Double -> Double) -> String -> PrimitiveFunc
floatBinaryOp Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/))
, (String
"numerator", String -> PrimitiveFunc
numerator')
, (String
"denominator", String -> PrimitiveFunc
denominator')
, (String
"fromMathExpr", String -> PrimitiveFunc
fromScalarData)
, (String
"toMathExpr'", String -> PrimitiveFunc
toScalarData)
, (String
"symbolNormalize", String -> PrimitiveFunc
symbolNormalize)
, (String
"modulo", (Integer -> Integer -> Integer) -> String -> PrimitiveFunc
integerBinaryOp Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod)
, (String
"quotient", (Integer -> Integer -> Integer) -> String -> PrimitiveFunc
integerBinaryOp Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot)
, (String
"%", (Integer -> Integer -> Integer) -> String -> PrimitiveFunc
integerBinaryOp Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem)
, (String
"b.abs", (Rational -> Rational) -> String -> PrimitiveFunc
rationalUnaryOp Rational -> Rational
forall a. Num a => a -> a
abs)
, (String
"b.neg", (Rational -> Rational) -> String -> PrimitiveFunc
rationalUnaryOp Rational -> Rational
forall a. Num a => a -> a
negate)
, (String
"=", String -> PrimitiveFunc
eq)
, (String
"<", (forall a. Ord a => a -> a -> Bool) -> String -> PrimitiveFunc
scalarCompare forall a. Ord a => a -> a -> Bool
(<))
, (String
"<=", (forall a. Ord a => a -> a -> Bool) -> String -> PrimitiveFunc
scalarCompare forall a. Ord a => a -> a -> Bool
(<=))
, (String
">", (forall a. Ord a => a -> a -> Bool) -> String -> PrimitiveFunc
scalarCompare forall a. Ord a => a -> a -> Bool
(>))
, (String
">=", (forall a. Ord a => a -> a -> Bool) -> String -> PrimitiveFunc
scalarCompare forall a. Ord a => a -> a -> Bool
(>=))
, (String
"round", (Double -> Integer) -> String -> PrimitiveFunc
floatToIntegerOp Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)
, (String
"floor", (Double -> Integer) -> String -> PrimitiveFunc
floatToIntegerOp Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor)
, (String
"ceiling", (Double -> Integer) -> String -> PrimitiveFunc
floatToIntegerOp Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling)
, (String
"truncate", String -> PrimitiveFunc
truncate')
, (String
"b.sqrt", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
sqrt)
, (String
"b.sqrt'", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
sqrt)
, (String
"b.exp", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
exp)
, (String
"b.log", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
log)
, (String
"b.sin", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
sin)
, (String
"b.cos", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
cos)
, (String
"b.tan", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
tan)
, (String
"b.asin", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
asin)
, (String
"b.acos", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
acos)
, (String
"b.atan", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
atan)
, (String
"b.sinh", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
sinh)
, (String
"b.cosh", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
cosh)
, (String
"b.tanh", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
tanh)
, (String
"b.asinh", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
asinh)
, (String
"b.acosh", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
acosh)
, (String
"b.atanh", (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp Double -> Double
forall a. Floating a => a -> a
atanh)
]
rationalUnaryOp :: (Rational -> Rational) -> String -> PrimitiveFunc
rationalUnaryOp :: (Rational -> Rational) -> String -> PrimitiveFunc
rationalUnaryOp = (Rational -> Rational) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp
integerBinaryOp :: (Integer -> Integer -> Integer) -> String -> PrimitiveFunc
integerBinaryOp :: (Integer -> Integer -> Integer) -> String -> PrimitiveFunc
integerBinaryOp = (Integer -> Integer -> Integer) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> a -> b) -> String -> PrimitiveFunc
binaryOp
floatUnaryOp :: (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp :: (Double -> Double) -> String -> PrimitiveFunc
floatUnaryOp = (Double -> Double) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp
floatBinaryOp :: (Double -> Double -> Double) -> String -> PrimitiveFunc
floatBinaryOp :: (Double -> Double -> Double) -> String -> PrimitiveFunc
floatBinaryOp = (Double -> Double -> Double) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> a -> b) -> String -> PrimitiveFunc
binaryOp
floatToIntegerOp :: (Double -> Integer) -> String -> PrimitiveFunc
floatToIntegerOp :: (Double -> Integer) -> String -> PrimitiveFunc
floatToIntegerOp = (Double -> Integer) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp
scalarBinaryOp :: (ScalarData -> ScalarData -> ScalarData) -> String -> PrimitiveFunc
scalarBinaryOp :: (ScalarData -> ScalarData -> ScalarData) -> String -> PrimitiveFunc
scalarBinaryOp ScalarData -> ScalarData -> ScalarData
mOp = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs EgisonValue -> EgisonValue -> EvalM EgisonValue
scalarBinaryOp'
where
scalarBinaryOp' :: EgisonValue -> EgisonValue -> EvalM EgisonValue
scalarBinaryOp' (ScalarData ScalarData
m1) (ScalarData ScalarData
m2) = (EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> (ScalarData -> EgisonValue) -> ScalarData -> EvalM EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarData -> EgisonValue
ScalarData) (ScalarData -> ScalarData -> ScalarData
mOp ScalarData
m1 ScalarData
m2)
scalarBinaryOp' (ScalarData ScalarData
_) EgisonValue
val = (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"number" (EgisonValue -> WHNFData
Value EgisonValue
val))
scalarBinaryOp' EgisonValue
val EgisonValue
_ = (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"number" (EgisonValue -> WHNFData
Value EgisonValue
val))
plus :: String -> PrimitiveFunc
plus :: String -> PrimitiveFunc
plus = (ScalarData -> ScalarData -> ScalarData) -> String -> PrimitiveFunc
scalarBinaryOp ScalarData -> ScalarData -> ScalarData
mathPlus
minus :: String -> PrimitiveFunc
minus :: String -> PrimitiveFunc
minus = (ScalarData -> ScalarData -> ScalarData) -> String -> PrimitiveFunc
scalarBinaryOp (\ScalarData
m1 ScalarData
m2 -> ScalarData -> ScalarData -> ScalarData
mathPlus ScalarData
m1 (ScalarData -> ScalarData
mathNegate ScalarData
m2))
multiply :: String -> PrimitiveFunc
multiply :: String -> PrimitiveFunc
multiply = (ScalarData -> ScalarData -> ScalarData) -> String -> PrimitiveFunc
scalarBinaryOp ScalarData -> ScalarData -> ScalarData
mathMult
divide :: String -> PrimitiveFunc
divide :: String -> PrimitiveFunc
divide = (ScalarData -> ScalarData -> ScalarData) -> String -> PrimitiveFunc
scalarBinaryOp ScalarData -> ScalarData -> ScalarData
mathDiv
numerator' :: String -> PrimitiveFunc
numerator' :: String -> PrimitiveFunc
numerator' = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg EgisonValue -> EvalM EgisonValue
numerator''
where
numerator'' :: EgisonValue -> EvalM EgisonValue
numerator'' (ScalarData ScalarData
m) = EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ ScalarData -> EgisonValue
ScalarData (ScalarData -> ScalarData
mathNumerator ScalarData
m)
numerator'' EgisonValue
val = (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"rational" (EgisonValue -> WHNFData
Value EgisonValue
val))
denominator' :: String -> PrimitiveFunc
denominator' :: String -> PrimitiveFunc
denominator' = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg EgisonValue -> EvalM EgisonValue
denominator''
where
denominator'' :: EgisonValue -> EvalM EgisonValue
denominator'' (ScalarData ScalarData
m) = EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ ScalarData -> EgisonValue
ScalarData (ScalarData -> ScalarData
mathDenominator ScalarData
m)
denominator'' EgisonValue
val = (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"rational" (EgisonValue -> WHNFData
Value EgisonValue
val))
fromScalarData :: String -> PrimitiveFunc
fromScalarData :: String -> PrimitiveFunc
fromScalarData = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg EgisonValue -> EvalM EgisonValue
fromScalarData'
where
fromScalarData' :: EgisonValue -> EvalM EgisonValue
fromScalarData' (ScalarData ScalarData
m) = EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ ScalarData -> EgisonValue
mathExprToEgison ScalarData
m
fromScalarData' EgisonValue
val = (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"number" (EgisonValue -> WHNFData
Value EgisonValue
val))
toScalarData :: String -> PrimitiveFunc
toScalarData :: String -> PrimitiveFunc
toScalarData = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val ->
ScalarData -> EgisonValue
ScalarData (ScalarData -> EgisonValue)
-> (ScalarData -> ScalarData) -> ScalarData -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScalarData -> ScalarData
mathNormalize' (ScalarData -> EgisonValue)
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
-> EvalM EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) ScalarData
egisonToScalarData EgisonValue
val
symbolNormalize :: String -> PrimitiveFunc
symbolNormalize :: String -> PrimitiveFunc
symbolNormalize = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val ->
case EgisonValue
val of
ScalarData ScalarData
s -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ ScalarData -> EgisonValue
ScalarData (ScalarData -> ScalarData
rewriteSymbol ScalarData
s)
EgisonValue
_ -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"math expression" (EgisonValue -> WHNFData
Value EgisonValue
val))
eq :: String -> PrimitiveFunc
eq :: String -> PrimitiveFunc
eq = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val EgisonValue
val' ->
EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool (Bool -> EgisonValue) -> Bool -> EgisonValue
forall a b. (a -> b) -> a -> b
$ EgisonValue
val EgisonValue -> EgisonValue -> Bool
forall a. Eq a => a -> a -> Bool
== EgisonValue
val'
scalarCompare :: (forall a. Ord a => a -> a -> Bool) -> String -> PrimitiveFunc
scalarCompare :: (forall a. Ord a => a -> a -> Bool) -> String -> PrimitiveFunc
scalarCompare forall a. Ord a => a -> a -> Bool
cmp = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val1 EgisonValue
val2 ->
case (EgisonValue
val1, EgisonValue
val2) of
(ScalarData ScalarData
_, ScalarData ScalarData
_) -> do
Rational
r1 <- EgisonValue -> EvalM Rational
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val1 :: EvalM Rational
Rational
r2 <- EgisonValue -> EvalM Rational
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val2 :: EvalM Rational
EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool (Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
cmp Rational
r1 Rational
r2)
(Float Double
f1, Float Double
f2) -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
cmp Double
f1 Double
f2)
(ScalarData ScalarData
_, EgisonValue
_) -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"number" (EgisonValue -> WHNFData
Value EgisonValue
val2))
(Float Double
_, EgisonValue
_) -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"float" (EgisonValue -> WHNFData
Value EgisonValue
val2))
(EgisonValue, EgisonValue)
_ -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"number" (EgisonValue -> WHNFData
Value EgisonValue
val1))
truncate' :: String -> PrimitiveFunc
truncate' :: String -> PrimitiveFunc
truncate' = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> EgisonValue -> EvalM EgisonValue
numberUnaryOp' EgisonValue
val
where
numberUnaryOp' :: EgisonValue -> EvalM EgisonValue
numberUnaryOp' (ScalarData (Div (Plus []) PolyExpr
_)) = EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Integer
0 :: Integer)
numberUnaryOp' (ScalarData (Div (Plus [Term Integer
x []]) (Plus [Term Integer
y []]))) = EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
x Integer
y)
numberUnaryOp' (Float Double
x) = EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x :: Integer)
numberUnaryOp' EgisonValue
val = (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"rational or float" (EgisonValue -> WHNFData
Value EgisonValue
val))