{-# LANGUAGE OverloadedStrings #-}
-- | (Unused) Parses & evaluates calc() expressions.
-- Implemented using The Shunting Yard Algorithm.
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) -- For error reporting.

-- | Parsed calc() expression. As a postfix arithmatic expression.
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
-- | Parse a calc() expression.
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"]

-- | Parse an operator char.
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 -- For function-calls.
op Char
_ = Text -> Opcode n
forall n. Text -> Opcode n
Func Text
"invalid"

-- Do operands counts line up? Are we dividing by 0?
-- Also I see concerns about whether units line up. Not bothering verifying that.
-- | Verify that a parsed math expression can be properly evaluated.
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

-- | Evaluate a parsed calc() expression.
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 -- The function args off
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

-- | Convert all numbers in an expression via the given callback.
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
-- GHC demanded more verbosity...
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 -- we can drop these while we're at it...
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
_ [] = []

-- | Convert from a tokenized NumericValue to a Float.
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

-- | Convert from a rational value to a float.
f :: Rational -> Float
f :: Rational -> Float
f = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational