{- |
Module      : Language.Egison.Primitives.Types
Licence     : MIT

This module implements primitive functions that dynamically checks the types of
objects.
-}

module Language.Egison.Primitives.Types
  ( primitiveTypeFunctions
  ) where

import           Data.Char                        (chr, ord)
import           Data.Ratio                       ((%))

import           Language.Egison.Data
import           Language.Egison.Math
import           Language.Egison.Primitives.Utils

primitiveTypeFunctions :: [(String, EgisonValue)]
primitiveTypeFunctions :: [(String, EgisonValue)]
primitiveTypeFunctions =
  ((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 [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++
    ((String, String -> LazyPrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> LazyPrimitiveFunc)]
-> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> LazyPrimitiveFunc
fn) -> (String
name, LazyPrimitiveFunc -> EgisonValue
LazyPrimitiveFunc (String -> LazyPrimitiveFunc
fn String
name))) [(String, String -> LazyPrimitiveFunc)]
lazyPrimitives

strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives :: [(String, String -> PrimitiveFunc)]
strictPrimitives =
  [ (String
"itof", String -> PrimitiveFunc
integerToFloat)
  , (String
"rtof", String -> PrimitiveFunc
rationalToFloat)
  , (String
"ctoi", String -> PrimitiveFunc
charToInteger)
  , (String
"itoc", String -> PrimitiveFunc
integerToChar)
  ]

lazyPrimitives :: [(String, String -> LazyPrimitiveFunc)]
lazyPrimitives :: [(String, String -> LazyPrimitiveFunc)]
lazyPrimitives =
  [ (String
"isInteger",    (WHNFData -> EvalM WHNFData) -> String -> LazyPrimitiveFunc
lazyOneArg WHNFData -> EvalM WHNFData
isInteger)
  , (String
"isRational",   (WHNFData -> EvalM WHNFData) -> String -> LazyPrimitiveFunc
lazyOneArg WHNFData -> EvalM WHNFData
isRational)
  -- Note: Other type checking functions (isBool, isScalar, isFloat, isChar, isString,
  -- isCollection, isHash, isTensor, typeName) are removed because they are not needed
  -- with the static type system. isInteger and isRational are kept because
  -- MathExpr = Integer = Rational in Egison.
  ]

--
-- Typing
-- Note: Only isInteger and isRational are kept because MathExpr = Integer = Rational in Egison.
-- Other type checking functions are removed as they are not needed with the static type system.
--

isInteger :: WHNFData -> EvalM WHNFData
isInteger :: WHNFData -> EvalM WHNFData
isInteger (Value (ScalarData (Div (Plus []) (Plus [Term Integer
1 []]))))          = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
True
isInteger (Value (ScalarData (Div (Plus [Term Integer
_ []]) (Plus [Term Integer
1 []])))) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
True
isInteger WHNFData
_                                                                = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
False

isRational :: WHNFData -> EvalM WHNFData
isRational :: WHNFData -> EvalM WHNFData
isRational (Value (ScalarData (Div (Plus []) (Plus [Term Integer
_ []]))))          = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
True
isRational (Value (ScalarData (Div (Plus [Term Integer
_ []]) (Plus [Term Integer
_ []])))) = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
True
isRational WHNFData
_                                                                = WHNFData -> EvalM WHNFData
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData)
-> (EgisonValue -> WHNFData) -> EgisonValue -> EvalM WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EgisonValue -> WHNFData
Value (EgisonValue -> EvalM WHNFData) -> EgisonValue -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ Bool -> EgisonValue
Bool Bool
False

--
-- Transform
--
integerToFloat :: String -> PrimitiveFunc
integerToFloat :: String -> PrimitiveFunc
integerToFloat = String -> PrimitiveFunc
rationalToFloat

rationalToFloat :: String -> PrimitiveFunc
rationalToFloat :: String -> PrimitiveFunc
rationalToFloat = (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 (Div (Plus []) PolyExpr
_)                           -> EgisonValue -> EvalM EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Double -> EgisonValue
Float Double
0
    ScalarData (Div (Plus [Term Integer
x []]) (Plus [Term Integer
y []])) -> EgisonValue -> EvalM EgisonValue
forall a. a -> StateT EvalState (ExceptT EgisonError RuntimeM) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ Double -> EgisonValue
Float (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
y))
    EgisonValue
_                                                      -> (CallStack -> EgisonError) -> EvalM EgisonValue
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"integer or rational number" (EgisonValue -> WHNFData
Value EgisonValue
val))

charToInteger :: String -> PrimitiveFunc
charToInteger :: String -> PrimitiveFunc
charToInteger = (Char -> Integer) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp Char -> Integer
ctoi
  where
    ctoi :: Char -> Integer
    ctoi :: Char -> Integer
ctoi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> (Char -> Int) -> Char -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

integerToChar :: String -> PrimitiveFunc
integerToChar :: String -> PrimitiveFunc
integerToChar = (Integer -> Char) -> String -> PrimitiveFunc
forall a b.
(EgisonData a, EgisonData b) =>
(a -> b) -> String -> PrimitiveFunc
unaryOp Integer -> Char
itoc
  where
    itoc :: Integer -> Char
    itoc :: Integer -> Char
itoc = Int -> Char
chr (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral