{-
-- EPITECH PROJECT, 2023
-- LobsterLang
-- File description:
-- vm
-}

module Vm (Operator(..),
           Value(..),
           Instruction(..),
           Stack,
           Inst,
           Arg,
           Func,
           Env,
           makeOperation,
           exec) where

import Stack
import Data.Ratio
import Data.Char

data Value = IntVal Int
           | BoolVal Bool
           | CharVal Char
           | StringVal String
           | ListVal [Value]
           | Op Operator
           | Function Func Int
           deriving (Int -> Value -> ShowS
Stack -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> (Stack -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: Stack -> ShowS
showList :: Stack -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord)

instance Num Value where
  (BoolVal Bool
x) + :: Value -> Value -> Value
+ (IntVal Int
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
  (IntVal Int
x) + (BoolVal Bool
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (IntVal Int
x) + (IntVal Int
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
  (BoolVal Bool
x) + (BoolVal Bool
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (CharVal Char
x) + (CharVal Char
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
y)
  (CharVal Char
x) + (IntVal Int
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
  (IntVal Int
x) + (CharVal Char
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
y)
  (BoolVal Bool
x) + (CharVal Char
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
y)
  (CharVal Char
x) + (BoolVal Bool
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  Value
_ + Value
_  = Int -> Value
IntVal Int
0
  (IntVal Int
x) - :: Value -> Value -> Value
- (IntVal Int
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)
  (BoolVal Bool
x) - (IntVal Int
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)
  (IntVal Int
x) - (BoolVal Bool
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (BoolVal Bool
x) - (BoolVal Bool
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (CharVal Char
x) - (CharVal Char
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
y)
  (CharVal Char
x) - (IntVal Int
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)
  (IntVal Int
x) - (CharVal Char
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
y)
  (BoolVal Bool
x) - (CharVal Char
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
y)
  (CharVal Char
x) - (BoolVal Bool
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  Value
_ - Value
_  = Int -> Value
IntVal Int
0
  (IntVal Int
x) * :: Value -> Value -> Value
* (IntVal Int
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y)
  (BoolVal Bool
x) * (IntVal Int
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y)
  (IntVal Int
x) * (BoolVal Bool
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (BoolVal Bool
x) * (BoolVal Bool
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (CharVal Char
x) * (CharVal Char
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> Int
ord Char
y)
  (CharVal Char
x) * (IntVal Int
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y)
  (IntVal Int
x) * (CharVal Char
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> Int
ord Char
y)
  (BoolVal Bool
x) * (CharVal Char
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Char -> Int
ord Char
y)
  (CharVal Char
x) * (BoolVal Bool
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  Value
_ * Value
_  = Int -> Value
IntVal Int
0
  abs :: Value -> Value
abs (IntVal Int
x) = Int -> Value
IntVal (Int -> Int
forall a. Num a => a -> a
abs Int
x)
  abs (BoolVal Bool
x) = Int -> Value
IntVal (Int -> Int
forall a. Num a => a -> a
abs (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x))
  abs (CharVal Char
x) = Int -> Value
IntVal (Int -> Int
forall a. Num a => a -> a
abs (Char -> Int
ord Char
x))
  abs Value
_ = Int -> Value
IntVal Int
0
  signum :: Value -> Value
signum (IntVal Int
x) = Int -> Value
IntVal (Int -> Int
forall a. Num a => a -> a
signum Int
x)
  signum (BoolVal Bool
x) = Int -> Value
IntVal (Int -> Int
forall a. Num a => a -> a
signum (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x))
  signum (CharVal Char
x) = Int -> Value
IntVal (Int -> Int
forall a. Num a => a -> a
signum (Char -> Int
ord Char
x))
  signum Value
_ = Int -> Value
IntVal Int
0
  fromInteger :: Integer -> Value
fromInteger Integer
x = Int -> Value
IntVal (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
x)

instance Fractional Value where
  (IntVal Int
x) / :: Value -> Value -> Value
/ (IntVal Int
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
y)
  (BoolVal Bool
x) / (IntVal Int
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
y)
  (IntVal Int
x) / (BoolVal Bool
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (BoolVal Bool
x) / (BoolVal Bool
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (CharVal Char
x) / (CharVal Char
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Char -> Int
ord Char
y)
  (CharVal Char
x) / (IntVal Int
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
y)
  (IntVal Int
x) / (CharVal Char
y) = Int -> Value
IntVal (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Char -> Int
ord Char
y)
  (CharVal Char
x) / (BoolVal Bool
y) = Int -> Value
IntVal (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
y)
  (BoolVal Bool
x) / (CharVal Char
y) = Int -> Value
IntVal (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Char -> Int
ord Char
y)
  Value
_ / Value
_ = Int -> Value
IntVal Int
0
  fromRational :: Rational -> Value
fromRational Rational
x = Int -> Value
IntVal (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x))

data Operator = Add
              | Sub
              | Mul
              | Div
              | Mod
              | Eq
              | Less
              | LessEq
              | Great
              | GreatEq
              | And
              | Or
              | Xorb
              | Not
              | ToString
              | Get
              | Append
              | RmOcc
              | Len

instance Ord Operator where
    compare :: Operator -> Operator -> Ordering
compare Operator
op1 Operator
op2 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Operator -> String
forall a. Show a => a -> String
show Operator
op1) (Operator -> String
forall a. Show a => a -> String
show Operator
op2)

instance Show Operator where
    show :: Operator -> String
show Operator
Add = String
"+"
    show Operator
Sub = String
"-"
    show Operator
Mul = String
"*"
    show Operator
Div = String
"/"
    show Operator
Mod = String
"%"
    show Operator
Eq = String
"=="
    show Operator
Less = String
"<"
    show Operator
LessEq = String
"<="
    show Operator
Great = String
">"
    show Operator
GreatEq = String
">="
    show Operator
And = String
"&&"
    show Operator
Or = String
"||"
    show Operator
Xorb = String
"^^"
    show Operator
Not = String
"!"
    show Operator
ToString = String
"@"
    show Operator
Get = String
"!!"
    show Operator
RmOcc = String
"--"
    show Operator
Append = String
"++"
    show Operator
Len = String
"~"

instance Eq Operator where
    Operator
Add == :: Operator -> Operator -> Bool
== Operator
Add = Bool
True
    Operator
Sub == Operator
Sub = Bool
True
    Operator
Mul == Operator
Mul = Bool
True
    Operator
Div == Operator
Div = Bool
True
    Operator
Eq == Operator
Eq = Bool
True
    Operator
Mod == Operator
Mod = Bool
True
    Operator
Less == Operator
Less = Bool
True
    Operator
Great == Operator
Great = Bool
True
    Operator
LessEq == Operator
LessEq = Bool
True
    Operator
GreatEq == Operator
GreatEq = Bool
True
    Operator
And == Operator
And = Bool
True
    Operator
Or == Operator
Or = Bool
True
    Operator
Xorb == Operator
Xorb = Bool
True
    Operator
Not == Operator
Not = Bool
True
    Operator
Len == Operator
Len = Bool
True
    Operator
_ == Operator
_ = Bool
False

data Instruction = Push Value
                | PushArg Int
                | PushEnv String
                | PutArg
                | Call
                | JumpIfFalse Int
                | JumpIfTrue Int
                | Jump Int
                | Define String
                | PushList Int
                | Ret

instance Show Instruction where
    show :: Instruction -> String
show (Push Value
val) = String
"Push " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
val
    show (PushArg Int
x) = String
"PushArg " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
    show (PushEnv String
x) = String
"PushEnv " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x
    show Instruction
PutArg = String
"PutArg"
    show Instruction
Call = String
"Call"
    show (JumpIfFalse Int
x) = String
"JumpIfFalse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
    show (JumpIfTrue Int
x) = String
"JumpIfTrue " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
    show (Jump Int
x) = String
"Jump " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
    show (Define String
x) = String
"Define " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x
    show Instruction
Ret = String
"Ret"
    show (PushList Int
x) = String
"PushList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x

instance Ord Instruction where
    compare :: Instruction -> Instruction -> Ordering
compare Instruction
inst1 Instruction
inst2 = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Instruction -> String
forall a. Show a => a -> String
show Instruction
inst1) (Instruction -> String
forall a. Show a => a -> String
show Instruction
inst2)

instance Eq Instruction where
    (Push Value
_) == :: Instruction -> Instruction -> Bool
== (Push Value
_) = Bool
True
    (PushArg Int
_) == (PushArg Int
_) = Bool
True
    (PushEnv String
_) == (PushEnv String
_) = Bool
True
    Instruction
Call == Instruction
Call = Bool
True
    (JumpIfFalse Int
_) == (JumpIfFalse Int
_) = Bool
True
    (JumpIfTrue Int
_) == (JumpIfTrue Int
_) = Bool
True
    Instruction
Ret == Instruction
Ret = Bool
True
    Instruction
_ == Instruction
_ = Bool
False

type Stack = [Value]
type Inst = [Instruction]
type Arg = [Value]
type Func = [Instruction]
type Env = [(String, Value, Int)]

makeOperation :: Operator -> Stack -> Either String Stack
makeOperation :: Operator -> Stack -> Either String Stack
makeOperation Operator
Add Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Add need two arguments"
    (Just (StringVal String
s), Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just (StringVal String
xs), Stack
stack2) ->
            Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (String -> Value
StringVal (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs)))
        (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : invalide operation on string"
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Add need two arguments"
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Value
x Value -> Value -> Value
forall a. Num a => a -> a -> a
+ Value
y))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Add need two arguments"
makeOperation Operator
Sub Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Value
x Value -> Value -> Value
forall a. Num a => a -> a -> a
- Value
y))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Sub need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Sub need two arguments"
makeOperation Operator
Mul Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Value
x Value -> Value -> Value
forall a. Num a => a -> a -> a
* Value
y))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Mul need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Mul need two arguments"
makeOperation Operator
Div Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just (BoolVal Bool
False), Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error: division by zero"
        (Just (IntVal Int
0), Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error: division by zero"
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Value
x Value -> Value -> Value
forall a. Fractional a => a -> a -> a
/ Value
y))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Div need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Div need two arguments"
makeOperation Operator
Mod Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> case (Value
x, Value
y) of
            (IntVal Int
a, IntVal Int
b) ->
                Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Int -> Value
IntVal (Int
a Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
b)))
            (Value, Value)
_ -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error: Mod needs two integer arguments"
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Mod need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Mod need two arguments"
makeOperation Operator
Eq Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2)
            | Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
True))
            | Bool
otherwise -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
False))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Equality need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Equality need two arguments"
makeOperation Operator
Less Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2)
            | Value
x Value -> Value -> Bool
forall a. Ord a => a -> a -> Bool
< Value
y -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
True))
            | Bool
otherwise -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
False))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Less need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Less need two arguments"
makeOperation Operator
LessEq Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2)
            | Value
x Value -> Value -> Bool
forall a. Ord a => a -> a -> Bool
<= Value
y -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
True))
            | Bool
otherwise -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
False))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : LessEq need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : LessEq need two arguments"
makeOperation Operator
Great Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2)
            | Value
x Value -> Value -> Bool
forall a. Ord a => a -> a -> Bool
> Value
y -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
True))
            | Bool
otherwise -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
False))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Great need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Great need two arguments"
makeOperation Operator
GreatEq Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2)
            | Value
x Value -> Value -> Bool
forall a. Ord a => a -> a -> Bool
>= Value
y -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
True))
            | Bool
otherwise -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal Bool
False))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : GreatEq need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : GreatEq need two arguments"
makeOperation Operator
And Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2
            (Bool -> Value
BoolVal (Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True Bool -> Bool -> Bool
&& Value
y Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True)))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : And need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : And need two arguments"
makeOperation Operator
Or Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2
            (Bool -> Value
BoolVal (Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True Bool -> Bool -> Bool
|| Value
y Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True)))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Or need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Or need two arguments"
makeOperation Operator
Xorb Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
y, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Bool -> Value
BoolVal
            ((Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True Bool -> Bool -> Bool
&& Value
y Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
False) Bool -> Bool -> Bool
|| (Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
False
            Bool -> Bool -> Bool
&& Value
y Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True))))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : XOrb need two arguments"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : XOrb need two arguments"
makeOperation Operator
Not Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just Value
x, Stack
stack1) ->
        Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (Bool -> Value
BoolVal (Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
False)))
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Not need One arguments"
makeOperation Operator
ToString Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just (IntVal Int
x), Stack
stack1) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (String -> Value
StringVal (Int -> String
forall a. Show a => a -> String
show Int
x)))
    (Just (BoolVal Bool
x), Stack
stack1) ->
        Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (String -> Value
StringVal (Bool -> String
forall a. Show a => a -> String
show Bool
x)))
    (Just (CharVal Char
x), Stack
stack1) ->
        Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (String -> Value
StringVal (Char -> String
forall a. Show a => a -> String
show Char
x)))
    (Just (StringVal String
x), Stack
stack1) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (String -> Value
StringVal String
x))
    (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Cannot convert to string"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : ToString need One arguments"
makeOperation Operator
Get Stack
stack = (Maybe Value, Stack) -> Either String Stack
makeOperationGet (Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack)
makeOperation Operator
Append Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just (ListVal Stack
l), Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
v, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Stack -> Value
ListVal (Stack
l Stack -> Stack -> Stack
forall a. [a] -> [a] -> [a]
++ [Value
v])))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Append need two arguments"
    (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Cannot Append on not a List"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Append need two arguments"
makeOperation Operator
RmOcc Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just (ListVal Stack
l), Stack
stack1) -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
        (Just Value
v, Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2
            (Stack -> Value
ListVal ((Value -> Bool) -> Stack -> Stack
forall a. (a -> Bool) -> [a] -> [a]
filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
v) Stack
l)))
        (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : RmOcc need two arguments"
    (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Cannot RmOcc on not a List"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : RmOcc need two arguments"
makeOperation Operator
Len Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Just (StringVal String
s), Stack
stack1) ->
        Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (Int -> Value
IntVal (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)))
    (Just (ListVal Stack
l), Stack
stack1) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack1 (Int -> Value
IntVal (Stack -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Stack
l)))
    (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Len no len"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Len need one arguments"

makeOperationGet :: (Maybe Value, Stack) -> Either String Stack
makeOperationGet :: (Maybe Value, Stack) -> Either String Stack
makeOperationGet (Just (StringVal String
s), Stack
stack1) = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
    (Just (IntVal Int
x), Stack
stack2) ->
        Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (String -> Value
StringVal [String
s String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
x]))
    (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Wrong arguments for Get"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Get need two arguments"
makeOperationGet (Just (ListVal Stack
l), Stack
stack1) = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack1 of
    (Just (IntVal Int
x), Stack
stack2) -> Stack -> Either String Stack
forall a b. b -> Either a b
Right (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack2 (Stack
l Stack -> Int -> Value
forall a. HasCallStack => [a] -> Int -> a
!! Int
x))
    (Just Value
_, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Wrong arguments for Get"
    (Maybe Value
Nothing, Stack
_) -> String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Get need two arguments"
makeOperationGet (Just Value
_, Stack
_) =
    String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Cannot Get on not a String nor List"
makeOperationGet (Maybe Value
Nothing, Stack
_) = String -> Either String Stack
forall a b. a -> Either a b
Left String
"Error : Get need two arguments"

isBoolVal :: Maybe Value -> Bool
isBoolVal :: Maybe Value -> Bool
isBoolVal (Just (BoolVal Bool
_)) = Bool
True
isBoolVal Maybe Value
_ = Bool
False

isInEnv :: String -> Int -> Env -> Maybe Value
isInEnv :: String -> Int -> Env -> Maybe Value
isInEnv String
_ Int
_ [] = Maybe Value
forall a. Maybe a
Nothing
isInEnv String
s Int
d ((String
name, Value
val, Int
depth):Env
as)
    | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s, Int
depth Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0, Int
d] = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
val
    | Bool
otherwise = String -> Int -> Env -> Maybe Value
isInEnv String
s Int
d Env
as

updateInEnv :: String -> Int -> Value -> Env -> Env
updateInEnv :: String -> Int -> Value -> Env -> Env
updateInEnv String
_ Int
_ Value
_ [] = []
updateInEnv String
s Int
d Value
nv ((String
name, Value
val, Int
depth):Env
as)
    | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s, Int
depth Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0, Int
d] = (String
name, Value
nv, Int
depth) (String, Value, Int) -> Env -> Env
forall a. a -> [a] -> [a]
: Env
as
    | Bool
otherwise = (String
name, Value
val, Int
depth) (String, Value, Int) -> Env -> Env
forall a. a -> [a] -> [a]
: String -> Int -> Value -> Env -> Env
updateInEnv String
s Int
d Value
nv Env
as

clearUntilDepth :: Env -> Int -> Env
clearUntilDepth :: Env -> Int -> Env
clearUntilDepth [] Int
_ = []
clearUntilDepth ((String
name, Value
val, Int
depth):Env
as) Int
d
    | Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
d = Env -> Int -> Env
clearUntilDepth Env
as Int
d
    | Bool
otherwise = (String
name, Value
val, Int
depth)(String, Value, Int) -> Env -> Env
forall a. a -> [a] -> [a]
:Env
as

createList :: Int -> Stack -> [Value] -> (Stack, [Value])
createList :: Int -> Stack -> Stack -> (Stack, Stack)
createList Int
0 Stack
stack Stack
val = (Stack
stack, Stack
val)
createList Int
n Stack
stack Stack
val = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Maybe Value
Nothing, Stack
_) -> (Stack
stack, Stack
val)
    (Just Value
x, Stack
stack1) -> Int -> Stack -> Stack -> (Stack, Stack)
createList (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Stack
stack1 (Stack
val Stack -> Stack -> Stack
forall a. [a] -> [a] -> [a]
++ [Value
x])

exec :: Int -> Env -> Arg -> Inst -> Stack -> (Either String Value, Env)
exec :: Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
_ Env
_ Stack
_ (Instruction
Call : Func
_) [] = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", [])
exec Int
depth Env
env Stack
arg (Instruction
Call : Func
xs) Stack
stack =
    Int
-> Env
-> Stack
-> Func
-> Stack
-> (Maybe Value, Stack)
-> (Either String Value, Env)
execCall Int
depth Env
env Stack
arg Func
xs Stack
stack (Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack)
exec Int
_ Env
_ [] (PushArg Int
_:Func
_) Stack
_ = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: no Arg", [])
exec Int
depth Env
env Stack
arg (PushArg Int
x:Func
xs) Stack
stack
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error index out of range", Env
env)
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Stack -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Stack
arg = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: index out of range", Env
env)
    | Bool
otherwise = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg Func
xs (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack (Stack
arg Stack -> Int -> Value
forall a. HasCallStack => [a] -> Int -> a
!! Int
x))
exec Int
depth Env
env Stack
arg (PushList Int
x:Func
xs) Stack
stack
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: index out of range", Env
env)
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Stack -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Stack
stack = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: index out of range", Env
env)
    | Bool
otherwise = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg Func
xs (Stack -> Value
ListVal ((Stack, Stack) -> Stack
forall a b. (a, b) -> b
snd (Int -> Stack -> Stack -> (Stack, Stack)
createList Int
x Stack
stack []))
        Value -> Stack -> Stack
forall a. a -> [a] -> [a]
: (Stack, Stack) -> Stack
forall a b. (a, b) -> a
fst (Int -> Stack -> Stack -> (Stack, Stack)
createList Int
x Stack
stack []))
exec Int
_ [] Stack
_ (PushEnv String
_:Func
_) Stack
_ = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: no Env", [])
exec Int
depth Env
env Stack
arg (PushEnv String
x:Func
xs) Stack
stack =  case String -> Int -> Env -> Maybe Value
isInEnv String
x Int
depth Env
env of
    Maybe Value
Nothing -> (String -> Either String Value
forall a b. a -> Either a b
Left (String
"Error: not in environment " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
depth),
        Env
env)
    Just (BoolVal Bool
b) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg  (Value -> Instruction
Push (Bool -> Value
BoolVal Bool
b)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
    Just (IntVal Int
i) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg  (Value -> Instruction
Push (Int -> Value
IntVal Int
i)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
    Just (CharVal Char
c) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg  (Value -> Instruction
Push (Char -> Value
CharVal Char
c)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
    Just (StringVal String
str) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg  (Value -> Instruction
Push (String -> Value
StringVal String
str)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
    Just (Op Operator
op) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg (Value -> Instruction
Push (Operator -> Value
Op Operator
op)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
    Just (Function Func
f Int
nb) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg (Value -> Instruction
Push (Func -> Int -> Value
Function Func
f Int
nb)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
    Just (ListVal Stack
list) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg (Value -> Instruction
Push (Stack -> Value
ListVal Stack
list)Instruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) Stack
stack
exec Int
depth Env
env Stack
arg (Push Value
val:Func
xs) Stack
stack =
    Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg Func
xs (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
stack Value
val)
exec Int
depth Env
env Stack
arg (Instruction
PutArg:Func
xs) Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Maybe Value
Nothing, Stack
_) -> (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
    (Just Value
val, Stack
stack1) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env (Stack
arg Stack -> Stack -> Stack
forall a. [a] -> [a] -> [a]
++ [Value
val]) Func
xs Stack
stack1
exec Int
depth Env
env Stack
arg (JumpIfFalse Int
val:Func
xs) Stack
stack
  | Func -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null Func
xs = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: no jump possible", Env
env)
  | Stack -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null Stack
stack = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: invalid jump value", Env
env)
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Func -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Func
xs = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: invalid jump value", Env
env)
  | Bool -> Bool
not (Maybe Value -> Bool
isBoolVal (Stack -> Maybe Value
forall a. [a] -> Maybe a
Stack.top Stack
stack)) = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: not bool", Env
env)
  | Stack -> Value
forall a. HasCallStack => [a] -> a
head Stack
stack Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
True = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg Func
xs Stack
stack
  | Bool
otherwise = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg (Int -> Func -> Func
forall a. Int -> [a] -> [a]
Prelude.drop Int
val Func
xs) Stack
stack
exec Int
depth Env
env Stack
arg (JumpIfTrue Int
val:Func
xs) Stack
stack
  | Func -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null Func
xs = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: no jump possible", Env
env)
  | Stack -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null Stack
stack = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: invalid jump value", Env
env)
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Func -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Func
xs = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: invalid jump value", Env
env)
  | Bool -> Bool
not (Maybe Value -> Bool
isBoolVal (Stack -> Maybe Value
forall a. [a] -> Maybe a
Stack.top Stack
stack)) = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: not bool", Env
env)
  | Stack -> Value
forall a. HasCallStack => [a] -> a
head Stack
stack Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
False = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg Func
xs Stack
stack
  | Bool
otherwise = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg (Int -> Func -> Func
forall a. Int -> [a] -> [a]
Prelude.drop Int
val Func
xs) Stack
stack
exec Int
depth Env
env Stack
arg (Jump Int
val:Func
xs) Stack
stack
  | Func -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null Func
xs = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: no jump possible", Env
env)
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: invalid jump value", Env
env)
  | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Func -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Func
xs = (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: invalid jump value", Env
env)
  | Bool
otherwise = Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth Env
env Stack
arg (Int -> Func -> Func
forall a. Int -> [a] -> [a]
Prelude.drop Int
val Func
xs) Stack
stack
exec Int
depth Env
env Stack
arg (Define String
str:Func
xs) Stack
stack = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
stack of
    (Maybe Value
Nothing, Stack
_) -> (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
    (Just Value
val, Stack
stack1) -> case String -> Int -> Env -> Maybe Value
isInEnv String
str Int
depth Env
env of
        Maybe Value
Nothing -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth ((String
str, Value
val, Int
depth)(String, Value, Int) -> Env -> Env
forall a. a -> [a] -> [a]
:Env
env) Stack
arg Func
xs Stack
stack1
        Maybe Value
_ -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
depth (String -> Int -> Value -> Env -> Env
updateInEnv String
str Int
depth Value
val Env
env) Stack
arg Func
xs Stack
stack1
exec Int
_ Env
env Stack
_ (Instruction
Ret : Func
_) Stack
stack = case Stack -> Maybe Value
forall a. [a] -> Maybe a
Stack.top Stack
stack of
    Just Value
x -> (Value -> Either String Value
forall a b. b -> Either a b
Right Value
x, Env
env)
    Maybe Value
Nothing -> (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
exec Int
_ Env
_ Stack
_ [] Stack
_ = (String -> Either String Value
forall a b. a -> Either a b
Left String
"list no instruction found", [])

execCall :: Int -> Env -> Arg -> Inst -> Stack ->
    (Maybe Value, Stack) -> (Either String Value, Env)
execCall :: Int
-> Env
-> Stack
-> Func
-> Stack
-> (Maybe Value, Stack)
-> (Either String Value, Env)
execCall Int
_ Env
env Stack
_ Func
_ Stack
_ (Maybe Value
Nothing, Stack
_) =
    (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
execCall Int
d Env
env Stack
arg Func
xs Stack
_ (Just (Op Operator
x), Stack
s1) =
    case Operator -> Stack -> Either String Stack
makeOperation Operator
x Stack
s1 of
       Left String
err -> (String -> Either String Value
forall a b. a -> Either a b
Left String
err, Env
env)
       Right Stack
news -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
d Env
env Stack
arg Func
xs Stack
news
execCall Int
d Env
env Stack
arg Func
xs Stack
_ (Just (Function Func
body Int
0), Stack
s1) =
    case Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Env
env [] Func
body [] of
        (Left String
err, Env
_) -> (String -> Either String Value
forall a b. a -> Either a b
Left String
err, Env
env)
        (Right Value
val, Env
env') -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
d (Env -> Int -> Env
clearUntilDepth Env
env' Int
d)
            Stack
arg Func
xs (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
s1 Value
val)
execCall Int
d Env
env Stack
arg Func
xs Stack
_ (Just (Function Func
body Int
nb), Stack
s1) = case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
s1 of
    (Just (IntVal Int
0), Stack
s2) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
d Env
env Stack
arg Func
xs
        (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push Stack
s2 (Func -> Int -> Value
Function Func
body Int
nb))
    (Just (IntVal Int
nb'), Stack
s2)
      | Int
nb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nb' -> (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: too much arguments given", Env
env)
      | Bool
otherwise -> case Stack -> (Maybe Value, Stack)
forall a. [a] -> (Maybe a, [a])
Stack.pop Stack
s2 of
        (Just Value
v, Stack
s3) -> Int -> Env -> Stack -> Func -> Stack -> (Either String Value, Env)
exec Int
d Env
env Stack
arg (Instruction
CallInstruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
xs) (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push (Stack -> Value -> Stack
forall a. [a] -> a -> [a]
Stack.push
          Stack
s3 (Int -> Value
IntVal (Int
nb' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) (Func -> Int -> Value
Function (Value -> Instruction
Push Value
vInstruction -> Func -> Func
forall a. a -> [a] -> [a]
:Instruction
PutArgInstruction -> Func -> Func
forall a. a -> [a] -> [a]
:Func
body) (Int
nb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
        (Maybe Value
Nothing, Stack
_) -> (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is empty", Env
env)
    (Maybe Value
_, Stack
_) -> (String -> Either String Value
forall a b. a -> Either a b
Left String
"Error: stack is invalid for a function call", Env
env)
execCall Int
_ Env
env Stack
_ Func
_ Stack
s  (Just Value
a, Stack
_) =
    (String -> Either String Value
forall a b. a -> Either a b
Left (String
"Error: not an Operation or a function " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Value -> String
forall a. Show a => a -> String
show Value
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"stack : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Stack -> String
forall a. Show a => a -> String
show Stack
s), Env
env)