{-# 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 -> 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
-- | Parse a calc() expression.
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"]

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

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

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

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

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