module calc

import StdEnv
import Data.Tuple
import Data.Either

:: Calculator = Calculator
instance zero Calculator where zero = Calculator
:: Memory =: Memory Int
instance zero Memory where zero = Memory 0
:: SquareRoot = SquareRoot
instance zero SquareRoot where zero = SquareRoot

:: Instructions = Push Int | Add | Sub | Mul | Div
:: MemInstructions = MC | MR | MP
:: SqrtInstructions = Sqrt

class calculator i c :: i [Int] c -> ([Int], c) | zero c

instance calculator Instructions Calculator
where
	calculator (Push i) stack c = ([i:stack], c)
	calculator Add stack c = (binop (+) stack, c)
	calculator Sub stack c = (binop (-) stack, c)
	calculator Mul stack c = (binop (*) stack, c)
	calculator Div stack c = (binop (/) stack, c)

instance calculator MemInstructions Memory
where
	calculator MC stack _ = (stack, Memory 0)
	calculator MR stack (Memory i) = ([i:stack], Memory i)
	calculator MP [i:stack] _ = (stack, Memory i)
	calculator MP _ _ = abort "Not enough elements on the stack"

instance calculator SqrtInstructions SquareRoot
where
	calculator Sqrt [i:stack] c = ([toInt (sqrt (toReal i)):stack], c)
	calculator Sqrt _ _ = abort "Not enough elements on the stack"

instance calculator (Either i1 i2) (c1, c2) | calculator i1 c1 & calculator i2 c2 & zero c1 & zero c2
where
	calculator (Left a) stack (c1, c2) = appSnd (flip tuple c2) (calculator a stack c1)
	calculator (Right b) stack (c1, c2) = appSnd (tuple c1) (calculator b stack c2)

instance zero (a, b) | zero a & zero b where zero = (zero, zero)

binop op [l,r:stack] = [op l r:stack]
binop _ _ = abort "Not enough elements on the stack"

Start = calculator instruction [9] state

instruction :: (Either Instructions (Either MemInstructions SqrtInstructions))
instruction = Right (Right Sqrt)

state :: (Calculator, (Memory, SquareRoot))
state = zero