{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.Arithmetic(Opcode(..), parseCalc, verifyCalc,
evalCalc, mapCalc) where
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Scientific (toRealFloat)
import GHC.Real (infinity)
import Data.Text (unpack, Text)
import qualified Data.Text as Txt
import Debug.Trace (trace)
data Opcode n = Seq | Add | Subtract | Multiply | Divide | Func Text | Num n deriving Int -> Opcode n -> ShowS
[Opcode n] -> ShowS
Opcode n -> [Char]
(Int -> Opcode n -> ShowS)
-> (Opcode n -> [Char]) -> ([Opcode n] -> ShowS) -> Show (Opcode n)
forall n. Show n => Int -> Opcode n -> ShowS
forall n. Show n => [Opcode n] -> ShowS
forall n. Show n => Opcode n -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> Opcode n -> ShowS
showsPrec :: Int -> Opcode n -> ShowS
$cshow :: forall n. Show n => Opcode n -> [Char]
show :: Opcode n -> [Char]
$cshowList :: forall n. Show n => [Opcode n] -> ShowS
showList :: [Opcode n] -> ShowS
Show
parseCalc :: [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc :: [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc (Number Text
_ NumericValue
n:[Token]
toks) [Opcode (Float, [Char])]
stack = (Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (NumericValue -> Float
val2float NumericValue
n, [Char]
"")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Percentage Text
_ NumericValue
n:[Token]
toks) [Opcode (Float, [Char])]
stack = (Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (NumericValue -> Float
val2float NumericValue
n, [Char]
"%")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Dimension Text
_ NumericValue
n Text
unit:[Token]
toks) [Opcode (Float, [Char])]
stack =
(Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (NumericValue -> Float
val2float NumericValue
n, Text -> [Char]
unpack Text
unit)Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Ident Text
"e":[Token]
toks) [Opcode (Float, [Char])]
stack = (Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (Float -> Float
forall a. Floating a => a -> a
exp Float
1, [Char]
"")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Ident Text
"pi":[Token]
toks) [Opcode (Float, [Char])]
stack = (Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (Float
forall a. Floating a => a
pi, [Char]
"")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Ident Text
"infinity":[Token]
toks) [Opcode (Float, [Char])]
stack = (Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (Rational -> Float
f Rational
infinity, [Char]
"")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Ident Text
"-infinity":[Token]
toks) [Opcode (Float, [Char])]
stack =
(Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (Float -> Float
forall a. Num a => a -> a
negate (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Rational -> Float
f Rational
infinity, [Char]
"")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Ident Text
"NaN":[Token]
toks) [Opcode (Float, [Char])]
stack = (Float, [Char]) -> Opcode (Float, [Char])
forall n. n -> Opcode n
Num (Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0, [Char]
"")Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Function Text
x:[Token]
toks) [Opcode (Float, [Char])]
stack = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks (Text -> Opcode (Float, [Char])
forall n. Text -> Opcode n
Func Text
xOpcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Opcode (Float, [Char])]
stack)
parseCalc (Token
LeftParen:[Token]
toks) [Opcode (Float, [Char])]
stack = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks (Text -> Opcode (Float, [Char])
forall n. Text -> Opcode n
Func Text
"calc"Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Opcode (Float, [Char])]
stack)
parseCalc toks' :: [Token]
toks'@(Delim Char
c:[Token]
toks) (Opcode (Float, [Char])
stack:[Opcode (Float, [Char])]
stacks)
| Opcode (Float, [Char]) -> Int
forall n. Opcode n -> Int
prec Opcode (Float, [Char])
stack Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Opcode Any -> Int
forall n. Opcode n -> Int
prec (Char -> Opcode Any
forall n. Char -> Opcode n
op Char
c) = Opcode (Float, [Char])
stackOpcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks' [Opcode (Float, [Char])]
stacks
| Bool
otherwise = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks (Char -> Opcode (Float, [Char])
forall n. Char -> Opcode n
op Char
cOpcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:Opcode (Float, [Char])
stackOpcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Opcode (Float, [Char])]
stacks)
where
prec :: Opcode n -> Int
prec :: forall n. Opcode n -> Int
prec Opcode n
Seq = Int
1
prec Opcode n
Add = Int
2
prec Opcode n
Subtract = Int
2
prec Opcode n
Multiply = Int
3
prec Opcode n
Divide = Int
3
prec (Func Text
_) = Int
0
prec (Num n
_) = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected number on operand stack!"
parseCalc (Delim Char
c:[Token]
toks) [] = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Char -> Opcode (Float, [Char])
forall n. Char -> Opcode n
op Char
c]
parseCalc (Token
Comma:[Token]
toks) [Opcode (Float, [Char])]
stack = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc (Char -> Token
Delim Char
','Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks) [Opcode (Float, [Char])]
stack
parseCalc (Token
RightParen:[Token]
toks) (Func Text
"calc":[Opcode (Float, [Char])]
stack) = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Token
RightParen:[Token]
toks) (op' :: Opcode (Float, [Char])
op'@(Func Text
_):[Opcode (Float, [Char])]
stack) = Opcode (Float, [Char])
op'Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc toks :: [Token]
toks@(Token
RightParen:[Token]
_) (Opcode (Float, [Char])
op':[Opcode (Float, [Char])]
stack) = Opcode (Float, [Char])
op'Opcode (Float, [Char])
-> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks [Opcode (Float, [Char])]
stack
parseCalc (Token
RightParen:[Token]
toks) [] = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token]
toks []
parseCalc [] [] = []
parseCalc [] [Opcode (Float, [Char])]
stack = [Token] -> [Opcode (Float, [Char])] -> [Opcode (Float, [Char])]
parseCalc [Token
RightParen] [Opcode (Float, [Char])]
stack
parseCalc [Token]
_ [Opcode (Float, [Char])]
_ = [Text -> Opcode (Float, [Char])
forall n. Text -> Opcode n
Func Text
"invalid"]
op :: Char -> Opcode n
op :: forall n. Char -> Opcode n
op Char
'+' = Opcode n
forall n. Opcode n
Add
op Char
'-' = Opcode n
forall n. Opcode n
Subtract
op Char
'*' = Opcode n
forall n. Opcode n
Multiply
op Char
'/' = Opcode n
forall n. Opcode n
Divide
op Char
',' = Opcode n
forall n. Opcode n
Seq
op Char
_ = Text -> Opcode n
forall n. Text -> Opcode n
Func Text
"invalid"
verifyCalc :: [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc :: [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc (Opcode (Float, [Char])
Seq:[Opcode (Float, [Char])]
expr) [Bool]
stack = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr [Bool]
stack
verifyCalc (Opcode (Float, [Char])
Add:[Opcode (Float, [Char])]
expr) (Bool
_:Bool
_:[Bool]
stack) = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Opcode (Float, [Char])
Subtract:[Opcode (Float, [Char])]
expr) (Bool
_:Bool
_:[Bool]
stack) = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Opcode (Float, [Char])
Multiply:[Opcode (Float, [Char])]
expr) (Bool
_:Bool
_:[Bool]
stack) = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Opcode (Float, [Char])
Divide:[Opcode (Float, [Char])]
_) (Bool
False:[Bool]
_) = Bool
False
verifyCalc (Opcode (Float, [Char])
Divide:[Opcode (Float, [Char])]
expr) (Bool
_:Bool
_:[Bool]
stack) = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Num (Float
n, [Char]
_):[Opcode (Float, [Char])]
expr) [Bool]
stack = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr ((Float
n Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Func Text
x:[Opcode (Float, [Char])]
expr) (Bool
_:[Bool]
stack)
| Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> [Text]
Txt.words Text
"abs acos asin atan cos exp log sign sin sqrt tan" =
[Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Func Text
x:[Opcode (Float, [Char])]
expr) (Bool
_:Bool
_:[Bool]
stack)
| Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> [Text]
Txt.words Text
"atan2 max min mod pow rem" = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Func Text
"clamp":[Opcode (Float, [Char])]
expr) (Bool
_:Bool
_:Bool
_:[Bool]
stack) = [Opcode (Float, [Char])] -> [Bool] -> Bool
verifyCalc [Opcode (Float, [Char])]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc [] [Bool
_] = Bool
True
verifyCalc [Opcode (Float, [Char])]
_ [Bool]
_ = Bool
False
evalCalc :: [Opcode Float] -> [Float] -> Float
evalCalc :: [Opcode Float] -> [Float] -> Float
evalCalc (Opcode Float
Seq:[Opcode Float]
expr) [Float]
stack = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr [Float]
stack
evalCalc (Opcode Float
Add:[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr ((Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Opcode Float
Subtract:[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr ((Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Opcode Float
Multiply:[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr ((Float
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Opcode Float
Divide:[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr ((Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Num Float
n:[Opcode Float]
expr) [Float]
stack = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float
nFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"abs":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Num a => a -> a
abs Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"acos":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
acos Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"asin":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
asin Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"atan":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
atan Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"atan2":[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 Float
x Float
yFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"clamp":[Opcode Float]
expr) (Float
high:Float
x:Float
low:[Float]
stack) =
[Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
high (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
low Float
x)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"cos":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
cos Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"exp":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
exp Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"log":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
log Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"max":[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x Float
yFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"min":[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x Float
yFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"mod":[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) =
[Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Int -> Float
forall a. Enum a => Int -> a
toEnum (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"pow":[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float
x Float -> Float -> Float
forall a. Floating a => a -> a -> a
** Float
yFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"rem":[Opcode Float]
expr) (Float
y:Float
x:[Float]
stack) =
[Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Int -> Float
forall a. Enum a => Int -> a
toEnum (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"sign":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Num a => a -> a
signum Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"sin":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
sin Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"sqrt":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
sqrt Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func Text
"tan":[Opcode Float]
expr) (Float
x:[Float]
stack) = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float -> Float
forall a. Floating a => a -> a
tan Float
xFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc [] [Float
ret] = Float
ret
evalCalc [] stack :: [Float]
stack@(Float
ret:[Float]
_) =
[Char] -> Float -> Float
forall a. [Char] -> a -> a
trace ([Char]
"Verification should have caught this error! " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Float] -> [Char]
forall a. Show a => a -> [Char]
show [Float]
stack) Float
ret
evalCalc [] [] = [Char] -> Float -> Float
forall a. [Char] -> a -> a
trace [Char]
"Verification should have caught this error! Stack underflow!" Float
0
evalCalc (Opcode Float
op:[Opcode Float]
_) (Float
ret:[Float]
_) =
[Char] -> Float -> Float
forall a. [Char] -> a -> a
trace ([Char]
"Verification should have caught this error! Unsupported op " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Opcode Float -> [Char]
forall a. Show a => a -> [Char]
show Opcode Float
op) Float
ret
evalCalc (Opcode Float
op:[Opcode Float]
_) [] =
[Char] -> Float -> Float
forall a. [Char] -> a -> a
trace ([Char]
"Verification should have caught this error! Unsupported op " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Opcode Float -> [Char]
forall a. Show a => a -> [Char]
show Opcode Float
op) Float
0
mapCalc :: (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc :: forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb (Num a
x:[Opcode a]
toks) = b -> Opcode b
forall n. n -> Opcode n
Num (a -> b
cb a
x)Opcode b -> [Opcode b] -> [Opcode b]
forall a. a -> [a] -> [a]
:(a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
cb (Opcode a
Seq:[Opcode a]
toks) = (a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
cb (Opcode a
Add:[Opcode a]
toks) = Opcode b
forall n. Opcode n
AddOpcode b -> [Opcode b] -> [Opcode b]
forall a. a -> [a] -> [a]
:(a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
cb (Opcode a
Subtract:[Opcode a]
toks) = Opcode b
forall n. Opcode n
SubtractOpcode b -> [Opcode b] -> [Opcode b]
forall a. a -> [a] -> [a]
:(a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
cb (Opcode a
Multiply:[Opcode a]
toks) = Opcode b
forall n. Opcode n
MultiplyOpcode b -> [Opcode b] -> [Opcode b]
forall a. a -> [a] -> [a]
:(a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
cb (Opcode a
Divide:[Opcode a]
toks) = Opcode b
forall n. Opcode n
DivideOpcode b -> [Opcode b] -> [Opcode b]
forall a. a -> [a] -> [a]
:(a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
cb (Func Text
f':[Opcode a]
toks) = Text -> Opcode b
forall n. Text -> Opcode n
Func Text
f'Opcode b -> [Opcode b] -> [Opcode b]
forall a. a -> [a] -> [a]
:(a -> b) -> [Opcode a] -> [Opcode b]
forall a b. (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc a -> b
cb [Opcode a]
toks
mapCalc a -> b
_ [] = []
val2float :: NumericValue -> Float
val2float :: NumericValue -> Float
val2float (NVInteger Integer
n) = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
val2float (NVNumber Scientific
n) = Scientific -> Float
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
n
f :: Rational -> Float
f :: Rational -> Float
f = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational