module Lua.Bytecode5_1.Chunk where

import Debug.Trace

import Data.Word
import Data.Int
import Data.Bits
import Data.ByteString
import Data.Serialize.Get
import Data.Serialize.IEEE754
import Data.Vector as Vector

import Lua.Bytecode5_1.Header
import Lua.Bytecode5_1.Types hiding (Function)

hasArg :: Chunk -> Bool
hasArg c =
	(varArg c .&. 1) /= 0

isVarArg :: Chunk -> Bool
isVarArg c =
	(varArg c .&. 2) /= 0

needsArg :: Chunk -> Bool
needsArg c =
	(varArg c .&. 4) /= 0

data Chunk = Chunk {
	  source :: ByteString
	, line :: Int32
	, lastLine :: Int32
	, upValueCount :: Word8
	, parameters :: Word8
	, varArg :: Word8
	, maxStackSize :: Word8
	, instructions :: Vector Operation
	, constants :: Vector Constant
	, prototypes :: Vector Chunk
	, sourcePositions :: Vector Int32
	, locals :: Vector Local
	, upValues :: Vector ByteString
}
	deriving (Show)

instance LuaGet Chunk where
	luaGet = getChunk

getChunk :: Get Chunk
getChunk = do
	--trace "getChunk" (return ())
	source <- luaGet
	line <- luaGet
	lastLine <- luaGet
	upValueCount <- luaGet
	parameters <- luaGet
	varArg <- luaGet
	maxStackSize <- luaGet
	instructions <- luaGet
	constants <- luaGet
	prototypes <- luaGet
	sourcePositions <- luaGet
	locals <- luaGet
	upValues <- luaGet
	return $ Chunk {..}

data Function = Function { header :: Header, chunk :: Chunk }
	deriving (Show)

instance LuaGet Function where
	luaGet = do
		--trace "getFunction" (return ())
		header <- luaGet
		chunk <- luaGet
		return $ Function {..}