{-# 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 -> String
(Int -> Opcode n -> ShowS)
-> (Opcode n -> String) -> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Opcode n] -> ShowS
$cshowList :: forall n. Show n => [Opcode n] -> ShowS
show :: Opcode n -> String
$cshow :: forall n. Show n => Opcode n -> String
showsPrec :: Int -> Opcode n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Opcode n -> ShowS
Show
parseCalc :: [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc :: [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc (Number _ n :: NumericValue
n:toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = (Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (NumericValue -> Float
val2float NumericValue
n, "")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Percentage _ n :: NumericValue
n:toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = (Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (NumericValue -> Float
val2float NumericValue
n, "%")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Dimension _ n :: NumericValue
n unit :: Unit
unit:toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack =
(Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (NumericValue -> Float
val2float NumericValue
n, Unit -> String
unpack Unit
unit)Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Ident "e":toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = (Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (Float -> Float
forall a. Floating a => a -> a
exp 1, "")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Ident "pi":toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = (Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (Float
forall a. Floating a => a
pi, "")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Ident "infinity":toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = (Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (Rational -> Float
f Rational
infinity, "")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Ident "-infinity":toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack =
(Float, String) -> Opcode (Float, String)
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, "")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Ident "NaN":toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = (Float, String) -> Opcode (Float, String)
forall n. n -> Opcode n
Num (0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/0, "")Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (Function x :: Unit
x:toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks (Unit -> Opcode (Float, String)
forall n. Unit -> Opcode n
Func Unit
xOpcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Opcode (Float, String)]
stack)
parseCalc (LeftParen:toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks (Unit -> Opcode (Float, String)
forall n. Unit -> Opcode n
Func "calc"Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Opcode (Float, String)]
stack)
parseCalc toks' :: [Token]
toks'@(Delim c :: Char
c:toks :: [Token]
toks) (stack :: Opcode (Float, String)
stack:stacks :: [Opcode (Float, String)]
stacks)
| Opcode (Float, String) -> Int
forall n. Opcode n -> Int
prec Opcode (Float, String)
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, String)
stackOpcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks' [Opcode (Float, String)]
stacks
| Bool
otherwise = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks (Char -> Opcode (Float, String)
forall n. Char -> Opcode n
op Char
cOpcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:Opcode (Float, String)
stackOpcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Opcode (Float, String)]
stacks)
where
prec :: Opcode n -> Int
prec :: Opcode n -> Int
prec Seq = 1
prec Add = 2
prec Subtract = 2
prec Multiply = 3
prec Divide = 3
prec (Func _) = 0
prec (Num _) = String -> Int
forall a. HasCallStack => String -> a
error "Unexpected number on operand stack!"
parseCalc (Delim c :: Char
c:toks :: [Token]
toks) [] = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Char -> Opcode (Float, String)
forall n. Char -> Opcode n
op Char
c]
parseCalc (Comma:toks :: [Token]
toks) stack :: [Opcode (Float, String)]
stack = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc (Char -> Token
Delim ','Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks) [Opcode (Float, String)]
stack
parseCalc (RightParen:toks :: [Token]
toks) (Func "calc":stack :: [Opcode (Float, String)]
stack) = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (RightParen:toks :: [Token]
toks) (op' :: Opcode (Float, String)
op'@(Func _):stack :: [Opcode (Float, String)]
stack) = Opcode (Float, String)
op'Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc toks :: [Token]
toks@(RightParen:_) (op' :: Opcode (Float, String)
op':stack :: [Opcode (Float, String)]
stack) = Opcode (Float, String)
op'Opcode (Float, String)
-> [Opcode (Float, String)] -> [Opcode (Float, String)]
forall a. a -> [a] -> [a]
:[Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks [Opcode (Float, String)]
stack
parseCalc (RightParen:toks :: [Token]
toks) [] = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token]
toks []
parseCalc [] [] = []
parseCalc [] stack :: [Opcode (Float, String)]
stack = [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
parseCalc [Token
RightParen] [Opcode (Float, String)]
stack
parseCalc _ _ = [Unit -> Opcode (Float, String)
forall n. Unit -> Opcode n
Func "invalid"]
op :: Char -> Opcode n
op :: Char -> Opcode n
op '+' = Opcode n
forall n. Opcode n
Add
op '-' = Opcode n
forall n. Opcode n
Subtract
op '*' = Opcode n
forall n. Opcode n
Multiply
op '/' = Opcode n
forall n. Opcode n
Divide
op ',' = Opcode n
forall n. Opcode n
Seq
op _ = Unit -> Opcode n
forall n. Unit -> Opcode n
Func "invalid"
verifyCalc :: [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc :: [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc (Seq:expr :: [Opcode (Float, String)]
expr) stack :: [Bool]
stack = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr [Bool]
stack
verifyCalc (Add:expr :: [Opcode (Float, String)]
expr) (_:_:stack :: [Bool]
stack) = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Subtract:expr :: [Opcode (Float, String)]
expr) (_:_:stack :: [Bool]
stack) = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Multiply:expr :: [Opcode (Float, String)]
expr) (_:_:stack :: [Bool]
stack) = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Divide:_) (False:_) = Bool
False
verifyCalc (Divide:expr :: [Opcode (Float, String)]
expr) (_:_:stack :: [Bool]
stack) = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Num (n :: Float
n, _):expr :: [Opcode (Float, String)]
expr) stack :: [Bool]
stack = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr ((Float
n Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== 0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Func x :: Unit
x:expr :: [Opcode (Float, String)]
expr) (_:stack :: [Bool]
stack)
| Unit
x Unit -> [Unit] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Unit -> [Unit]
Txt.words "abs acos asin atan cos exp log sign sin sqrt tan" =
[Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Func x :: Unit
x:expr :: [Opcode (Float, String)]
expr) (_:_:stack :: [Bool]
stack)
| Unit
x Unit -> [Unit] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Unit -> [Unit]
Txt.words "atan2 max min mod pow rem" = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc (Func "clamp":expr :: [Opcode (Float, String)]
expr) (_:_:_:stack :: [Bool]
stack) = [Opcode (Float, String)] -> [Bool] -> Bool
verifyCalc [Opcode (Float, String)]
expr (Bool
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
stack)
verifyCalc [] [_] = Bool
True
verifyCalc _ _ = Bool
False
evalCalc :: [Opcode Float] -> [Float] -> Float
evalCalc :: [Opcode Float] -> [Float] -> Float
evalCalc (Seq:expr :: [Opcode Float]
expr) stack :: [Float]
stack = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr [Float]
stack
evalCalc (Add:expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 (Subtract:expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 (Multiply:expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 (Divide:expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 n :: Float
n:expr :: [Opcode Float]
expr) stack :: [Float]
stack = [Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Float
nFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func "abs":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "acos":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "asin":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "atan":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "atan2":expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 "clamp":expr :: [Opcode Float]
expr) (high :: Float
high:x :: Float
x:low :: Float
low:stack :: [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 "cos":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "exp":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "log":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "max":expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 "min":expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 "mod":expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [Float]
stack) =
[Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Int -> Float
forall a. Enum a => Int -> a
toEnum (Float -> Int
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 a b. (RealFrac a, Integral b) => a -> b
round Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func "pow":expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [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 "rem":expr :: [Opcode Float]
expr) (y :: Float
y:x :: Float
x:stack :: [Float]
stack) =
[Opcode Float] -> [Float] -> Float
evalCalc [Opcode Float]
expr (Int -> Float
forall a. Enum a => Int -> a
toEnum (Float -> Int
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 a b. (RealFrac a, Integral b) => a -> b
round Float
y)Float -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
stack)
evalCalc (Func "sign":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "sin":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "sqrt":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 "tan":expr :: [Opcode Float]
expr) (x :: Float
x:stack :: [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 [] [ret :: Float
ret] = Float
ret
evalCalc [] stack :: [Float]
stack@(ret :: Float
ret:_) =
String -> Float -> Float
forall a. String -> a -> a
trace ("Verification should have caught this error! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Float] -> String
forall a. Show a => a -> String
show [Float]
stack) Float
ret
evalCalc [] [] = String -> Float -> Float
forall a. String -> a -> a
trace "Verification should have caught this error! Stack underflow!" 0
evalCalc (op :: Opcode Float
op:_) (ret :: Float
ret:_) =
String -> Float -> Float
forall a. String -> a -> a
trace ("Verification should have caught this error! Unsupported op " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Opcode Float -> String
forall a. Show a => a -> String
show Opcode Float
op) Float
ret
evalCalc (op :: Opcode Float
op:_) [] =
String -> Float -> Float
forall a. String -> a -> a
trace ("Verification should have caught this error! Unsupported op " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Opcode Float -> String
forall a. Show a => a -> String
show Opcode Float
op) 0
mapCalc :: (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc :: (a -> b) -> [Opcode a] -> [Opcode b]
mapCalc cb :: a -> b
cb (Num x :: a
x:toks :: [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 cb :: a -> b
cb (Seq:toks :: [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 cb :: a -> b
cb (Add:toks :: [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 cb :: a -> b
cb (Subtract:toks :: [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 cb :: a -> b
cb (Multiply:toks :: [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 cb :: a -> b
cb (Divide:toks :: [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 cb :: a -> b
cb (Func f' :: Unit
f':toks :: [Opcode a]
toks) = Unit -> Opcode b
forall n. Unit -> Opcode n
Func Unit
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 _ [] = []
val2float :: NumericValue -> Float
val2float :: NumericValue -> Float
val2float (NVInteger n :: Integer
n) = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
val2float (NVNumber n :: 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