{-
-- EPITECH PROJECT, 2026
-- Glados
-- File description:
-- List
-}

module VM.Instruction.List
    ( instCons
    , instHead
    , instTail
    , instNth
    , instNthUpdate
    , instBuildList
    ) where

import qualified Data.Vector as V
import Control.Monad.State.Strict (get, put)
import VM.Bytecode.Reader (readInt32)

import VM.VMState (VirtualMachine, VMState(..))
import VM.VMValue (VMValue(..), valueToInt)
import VM.VMStack (stackPop, stackPush)
import Common.Type.Integer (intValueToInt)

-- | Implements CONS (Opcode 0x90).
--
-- @details
--   Constructs a new list by prepending an element.
--   Stack: [..., elem, list] -> [..., new_list]
--   Note: Pops 'list' first (Right), then 'elem' (Left).
--
instCons :: VirtualMachine ()
instCons :: VirtualMachine ()
instCons = do
    listVal <- VirtualMachine VMValue
stackPop
    elemVal <- stackPop
    case listVal of
        VList Vector VMValue
v -> VMValue -> VirtualMachine ()
stackPush (Vector VMValue -> VMValue
VList (VMValue -> Vector VMValue -> Vector VMValue
forall a. a -> Vector a -> Vector a
V.cons VMValue
elemVal Vector VMValue
v))
        VMValue
_       -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: CONS expects a List as second argument"

-- | Implements HEAD (Opcode 0x91).
--
-- @details
--   Extracts the first element of a list.
--   Stack: [..., list] -> [..., head]
--
-- @throws Error if list is empty.
--
instHead :: VirtualMachine ()
instHead :: VirtualMachine ()
instHead = do
    listVal <- VirtualMachine VMValue
stackPop
    case listVal of
        VList Vector VMValue
v -> case Vector VMValue -> Bool
forall a. Vector a -> Bool
V.null Vector VMValue
v of
            Bool
True  -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: HEAD called on empty list"
            Bool
False -> VMValue -> VirtualMachine ()
stackPush (Vector VMValue -> VMValue
forall a. Vector a -> a
V.head Vector VMValue
v)
        VMValue
_ -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: HEAD expects a List"

-- | Implements TAIL (Opcode 0x92).
--
-- @details
--   Extracts the rest of the list (minus the first element).
--   Stack: [..., list] -> [..., tail]
--
-- @throws Error if list is empty.
--
instTail :: VirtualMachine ()
instTail :: VirtualMachine ()
instTail = do
    listVal <- VirtualMachine VMValue
stackPop
    case listVal of
        VList Vector VMValue
v -> case Vector VMValue -> Bool
forall a. Vector a -> Bool
V.null Vector VMValue
v of
            Bool
True  -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: TAIL called on empty list"
            Bool
False -> VMValue -> VirtualMachine ()
stackPush (Vector VMValue -> VMValue
VList (Vector VMValue -> Vector VMValue
forall a. Vector a -> Vector a
V.tail Vector VMValue
v))
        VMValue
_ -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: TAIL expects a List"

-- | Implements NTH (Opcode 0x93).
--
-- @details
--   Access to a list element.
--   Stack: [index, list] -> [element]
--
instNth :: VirtualMachine ()
instNth :: VirtualMachine ()
instNth = do
    idxVal <- VirtualMachine VMValue
stackPop
    listVal <- stackPop
    let idx = VMValue -> Int
valueToInt VMValue
idxVal
    case listVal of
        VList Vector VMValue
v -> case Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector VMValue -> Int
forall a. Vector a -> Int
V.length Vector VMValue
v of
            Bool
True  -> VMValue -> VirtualMachine ()
stackPush (Vector VMValue
v Vector VMValue -> Int -> VMValue
forall a. Vector a -> Int -> a
V.! Int
idx)
            Bool
False -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> VirtualMachine ()) -> [Char] -> VirtualMachine ()
forall a b. (a -> b) -> a -> b
$ [Char]
"VM Error: Nth OOB (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
        VMValue
_ -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: Nth expects a List"

-- | Implements NTH_UPDATE (Opcode 0x95).
--
-- @details
--   Updates an element in a list at a given index.
--   Note: Since VMValues are immutable, this pushes a NEW list.
--
--   Stack Order (arg order: list, index, value):
--     Top    -> Value
--     Next   -> Index
--     Bottom -> List
--
instNthUpdate :: VirtualMachine ()
instNthUpdate :: VirtualMachine ()
instNthUpdate = do
    val <- VirtualMachine VMValue
stackPop
    idxVal <- stackPop
    listVal <- stackPop
    case (listVal, idxVal) of
        (VList Vector VMValue
vec, VInt IntValue
i) -> let idx :: Int
idx = IntValue -> Int
intValueToInt IntValue
i in
            case Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector VMValue -> Int
forall a. Vector a -> Int
V.length Vector VMValue
vec of
                Bool
True -> VMValue -> VirtualMachine ()
stackPush (Vector VMValue -> VMValue
VList (Vector VMValue
vec Vector VMValue -> [(Int, VMValue)] -> Vector VMValue
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
idx, VMValue
val)]))
                Bool
False -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> VirtualMachine ()) -> [Char] -> VirtualMachine ()
forall a b. (a -> b) -> a -> b
$ [Char]
"VM Error: NthUpdate OOB (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
        (VMValue, VMValue)
_ -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: NthUpdate expects List and Integer idx"

-- | Implements BUILD_LIST (Opcode 0x94).
--
-- @details
--   Pop 'n' elements from the stack and creates a VList.
--   Preserves the order: [e1, e2] -> push e1 -> push e2 -> BuildList 2 -> VList [e1, e2]
--
instBuildList :: VirtualMachine ()
instBuildList :: VirtualMachine ()
instBuildList = do
    count <- VirtualMachine Int
readInt32
    vm <- get
    let size = Vector VMValue -> Int
forall a. Vector a -> Int
V.length (VMState -> Vector VMValue
vStack VMState
vm)
    case size < count of
        Bool
True -> [Char] -> VirtualMachine ()
forall a. HasCallStack => [Char] -> a
error [Char]
"VM Error: BUILD_LIST Stack Underflow"
        Bool
False -> let start :: Int
start = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count
                     elements :: Vector VMValue
elements = Int -> Int -> Vector VMValue -> Vector VMValue
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
start Int
count (VMState -> Vector VMValue
vStack VMState
vm) in
                VMState -> VirtualMachine ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (VMState
vm { vStack = V.take start (vStack vm) }) VirtualMachine () -> VirtualMachine () -> VirtualMachine ()
forall a b.
StateT VMState IO a -> StateT VMState IO b -> StateT VMState IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                VMValue -> VirtualMachine ()
stackPush (Vector VMValue -> VMValue
VList Vector VMValue
elements)