From d0a8a7d61e0a8340adcb597e0c8f94553dbaff81 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 13 Feb 2023 16:09:00 +1300
Subject: [PATCH] Finish drafting shunting yard interpreter for calc().

---
 Graphics/Layout/Arithmetic.hs | 38 +++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

diff --git a/Graphics/Layout/Arithmetic.hs b/Graphics/Layout/Arithmetic.hs
index d5c60e3..31b77a6 100644
--- a/Graphics/Layout/Arithmetic.hs
+++ b/Graphics/Layout/Arithmetic.hs
@@ -6,7 +6,7 @@ import Data.Scientific (toRealFloat)
 import GHC.Real (infinity)
 import Data.Text (unpack, Text)
 
-data Opcode n = Add | Subtract | Multiply | Divide | Func Text | Num n
+data Opcode n = Comma | Add | Subtract | Multiply | Divide | Func Text | Num n
 parseCalc :: [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
 parseCalc (Number _ n:toks) stack = Num (val2float n, ""):parseCalc toks stack
 parseCalc (Percentage _ n:toks) stack = Num (val2float n, "%"):parseCalc toks stack
@@ -40,6 +40,28 @@ parseCalc (Comma:toks) stack = parseCalc (Delim ',':toks) stack
 parseCalc (RightParen:toks) (Func "calc":stack) = parseCalc toks stack
 parseCalc (RightParen:toks) (op@Func _:stack) = op:parseCalc toks stack
 parseCalc toks@(RightParen:_) (op:stack) = op:parseCalc toks stack
+parseCalc [] [] = []
+parseCalc [] stack = parseCalc [RightParen] stack
+parseCalc _ _ = [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.
+verifyCalc :: [Opcode (Float, String)] -> [Bool] -> Bool
+verifyCalc (Comma:expr) stack = verifyCalc expr stack
+verifyCalc (Add:expr) (_:_:stack) = verifyCalc expr (True:stack)
+verifyCalc (Minus:expr) (_:_:stack) = verifyCalc expr (True:stack)
+verifyCalc (Multiply:expr) (_:_:stack) = verifyCalc expr (True:stack)
+verifyCalc (Divide:expr) (False:_) = False
+verifyCalc (Divide:expr) (_:_:stack) = verifyCalc expr (True:stack)
+verifyCalc (Num (n, _):expr) stack = verifyCalc expr ((n == 0):stack)
+verifyCalc (Func x:expr) (_:stack)
+    | x `elem` words "abs acos asin atan atan2 cos exp log sign sin sqrt tan" =
+        verifyCalc expr (True:stack)
+verifyCalc (Func x:expr) (_:_:stack)
+    | x `elem` words "max min mod pow rem" = verifyCalc expr (True:stack)
+verifyCalc (Func "clamp":expr) (_:_:_:stack) = verifyCalc expr (True:stack)
+verifyCalc [] [_] = True
+verifyCalc _ _ = False
 
 evalCalc :: Num n => [Opcode n] -> [n] -> n
 evalCalc (Comma:expr) stack = evalCalc expr stack -- The function args off
@@ -60,10 +82,22 @@ evalCalc (Func "cos":expr) (x:stack) = evalCalc expr (cos x:stack)
 evalCalc (Func "exp":expr) (x:stack) = evalCalc expr (exp x:stack)
 evalCalc (Func "log":expr) (x:stack) = evalCalc expr (log x:stack)
 evalCalc (Func "max":expr) (y:x:stack) = evalCalc expr (maximum x y:stack)
+evalCalc (Func "min":expr) (y:x:stack) = evalCalc expr (minimum x y:stack)
+evalCalc (Func "mod":expr) (y:x:stack) = evalCalc expr (mod x y:stack)
+evalCalc (Func "pow":expr) (y:x:stack) = evalCalc expr (x ** y:stack)
+evalCalc (Func "rem":expr) (y:x:stack) = evalCalc expr (rem x y:stack)
+evalCalc (Func "sign":expr) (x:stack) = evalCalc expr (sign x:stack)
+evalCalc (Func "sin":expr) (x:stack) = evalCalc expr (sin x:stack)
+evalCalc (Func "sqrt":expr) (x:stack) = evalCalc expr (sqrt x:stack)
+evalCalc (Func "tan":expr) (x:stack) = evalCalc expr (tan x:stack)
 
 evalCalc [] [ret] = ret
-evalCalc _ _ = error "Should have been caught by validation."
+evalCalc _ _ = error "Verification should have caught this error!"
+
 mapCalc :: (a -> b) -> [Opcode a] -> [Opcode b]
+mapCalc cb (Num x:toks) = Num (cb x):mapCalc cb toks
+mapCalc cb (tok:toks) = tok:mapCalc cb toks
+mapCalc _ [] = []
 
 val2float (NVInteger n) = fromIntegral n
 val2float (NVScientific n) = toRealFloat n
-- 
2.30.2