From 474bbc4e0ba0be7bdb7b84d0dba7d84931a555a0 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 13 Feb 2023 15:40:35 +1300
Subject: [PATCH] Draft shunting yard interpreter for calc().

---
 Graphics/Layout/Arithmetic.hs | 67 +++++++++++++++++++++++++++++++++--
 1 file changed, 64 insertions(+), 3 deletions(-)

diff --git a/Graphics/Layout/Arithmetic.hs b/Graphics/Layout/Arithmetic.hs
index 1486f9e..d5c60e3 100644
--- a/Graphics/Layout/Arithmetic.hs
+++ b/Graphics/Layout/Arithmetic.hs
@@ -1,8 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Graphics.Layout.Arithmetic where
 
 import Data.CSS.Tokens (Token(..))
+import Data.Scientific (toRealFloat)
+import GHC.Real (infinity)
+import Data.Text (unpack, Text)
 
-data Opcode n = Add | Subtract | Multiply | Divide | Clamp | Num n
-parseCalc :: [Token] -> [Opcode Length]
-evalCalc :: [Opcode n] -> n
+data Opcode n = 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
+parseCalc (Dimension _ n unit:toks) stack =
+    Num (val2float n, unpack unit):parseCalc toks stack
+parseCalc (Ident "e":toks) stack = Num (exp 1, ""):parseCalc toks stack
+parseCalc (Ident "pi":toks) stack = Num (pi, ""):parseCalc toks stack
+parseCalc (Ident "infinity":toks) stack = Num (infinity, ""):parseCalc toks stack
+parseCalc (Ident "-infinity":toks) stack = Num (-infinity, ""):parseCalc toks stack
+parseCalc (Ident "NaN":toks) stack = Num (0/0, ""):parseCalc toks stack
+
+parseCalc (Func x:toks) stack = parseCalc toks (Func x:stack)
+parseCalc (LeftParen:toks) stack = parseCalc toks (Func "calc":stack)
+parseCalc toks'@(Delim c:toks) (stack:stacks)
+    | prec stack >= prec (op c) = stack:parseCalc toks' stacks
+    | otherwise = parseCalc toks (op c:stack:stacks)
+  where
+    prec Comma = 1
+    prec Add = 2
+    prec Subtract = 2
+    prec Multiply = 3
+    prec Divide = 3
+    prec (Func _) = 0
+    prec (Num _) = error "Unexpected number on operand stack!"
+    op '+' = Add
+    op '-' = Subtract
+    op '*' = Multiply
+    op '/' = Divide
+    op ',' = Comma -- For function-calls.
+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
+
+evalCalc :: Num n => [Opcode n] -> [n] -> n
+evalCalc (Comma:expr) stack = evalCalc expr stack -- The function args off
+evalCalc (Add:expr) (y:x:stack) = evalCalc expr ((x + y):stack)
+evalCalc (Minus:expr) (y:x:stack) = evalCalc expr ((x - y):stack)
+evalCalc (Multiply:expr) (y:x:stack) = evalCalc expr ((x*y):stack)
+evalCalc (Divide:expr) (y:x:stack) = evalCalc expr ((x/y):stack)
+evalCalc (Num n:expr) stack = evalCalc expr (n:stack)
+
+evalCalc (Func "abs":expr) (x:stack) = evalCalc expr (abs x:stack)
+evalCalc (Func "acos":expr) (x:stack) = evalCalc expr (acos x:stack)
+evalCalc (Func "asin":expr) (x:stack) = evalCalc expr (asin x:stack)
+evalCalc (Func "atan":expr) (x:stack) = evalCalc expr (atan x:stack)
+evalCalc (Func "atan2":expr) (x:stack) = evalCalc expr (atan2 x:stack)
+evalCalc (Func "clamp":expr) (max:x:min:stack) =
+    evalCalc expr (clamp (min, max) x:stack)
+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 [] [ret] = ret
+evalCalc _ _ = error "Should have been caught by validation."
 mapCalc :: (a -> b) -> [Opcode a] -> [Opcode b]
+
+val2float (NVInteger n) = fromIntegral n
+val2float (NVScientific n) = toRealFloat n
-- 
2.30.2