From d67dacb7b7f474ce3b0aa13a07ba3907daafa1f7 Mon Sep 17 00:00:00 2001 From: tenshi Date: Mon, 15 Jan 2024 00:36:36 +0100 Subject: [PATCH 1/2] fix unused and shadowing warnings --- lvtrun/src/OpCodes.hs | 18 +++++++-------- lvtrun/src/Parsing/Code.hs | 27 +++++++++++----------- lvtrun/src/Parsing/Exports.hs | 32 ++++++++++--------------- lvtrun/src/Parsing/FuncTypes.hs | 28 +++++++++++----------- lvtrun/src/Parsing/Functions.hs | 21 +++++++++-------- lvtrun/src/Parsing/Global.hs | 32 ++++++++++++------------- lvtrun/src/Parsing/Memory.hs | 24 +++++++++---------- lvtrun/src/Parsing/Sections.hs | 12 +++++----- lvtrun/src/Run/Functions.hs | 12 +++++----- lvtrun/src/Run/Types.hs | 2 +- lvtrun/src/Run/Vm.hs | 41 ++++++++++++++++++--------------- lvtrun/src/Types.hs | 4 +--- 12 files changed, 124 insertions(+), 129 deletions(-) diff --git a/lvtrun/src/OpCodes.hs b/lvtrun/src/OpCodes.hs index 9c2030c..df4602e 100644 --- a/lvtrun/src/OpCodes.hs +++ b/lvtrun/src/OpCodes.hs @@ -62,7 +62,7 @@ extractOpCode' (0x3f:0x00:rest) = ([0x3f, 0x00], BSL.pack rest) extractOpCode' (0x40:0x00:rest) = ([0x40, 0x00], BSL.pack rest) extractOpCode' (0x04:0x40:rest) = ([0x04, 0x40], BSL.pack rest) extractOpCode' (0x03:0x40:rest) = ([0x03, 0x40], BSL.pack rest) -extractOpCode' idx = throw $ WasmError "ExtractOpCode: bad opcode" +extractOpCode' _ = throw $ WasmError "ExtractOpCode: bad opcode" extractOpCode :: BSL.ByteString -> ([Word8], BSL.ByteString) extractOpCode bytes = extractOpCode' (BSL.unpack bytes) @@ -117,16 +117,16 @@ createInstruction [0x21] bytes = (\(value, rest) -> (SetLocal value, rest)) (getLEB128ToI32 bytes) createInstruction [0x44] bytes = (\(value, rest) -> (F64Const (fromIntegral value), rest)) (getLEB128ToI64 bytes) -createInstruction [0x28] bytes = (\(align, rest) -> - (\(offset, rest2) -> (I32Load (MemArg offset align), rest2)) +createInstruction [0x28] bytes = (\(alignn, rest) -> + (\(fset, rest2) -> (I32Load (MemArg fset alignn), rest2)) (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) -createInstruction [0x29] bytes = (\(align, rest) -> - (\(offset, rest2) -> (I64Load (MemArg offset align), rest2)) +createInstruction [0x29] bytes = (\(alignn, rest) -> + (\(fset, rest2) -> (I64Load (MemArg fset alignn), rest2)) (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) -createInstruction [0x36] bytes = (\(align, rest) -> - (\(offset, rest2) -> (I32Store (MemArg offset align), rest2)) +createInstruction [0x36] bytes = (\(alignn, rest) -> + (\(fset, rest2) -> (I32Store (MemArg fset alignn), rest2)) (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) -createInstruction [0x37] bytes = (\(align, rest) -> - (\(offset, rest2) -> (I64Store (MemArg offset align), rest2)) +createInstruction [0x37] bytes = (\(alignn, rest) -> + (\(fset, rest2) -> (I64Store (MemArg fset alignn), rest2)) (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) createInstruction _ _ = throw $ WasmError "createInstruction: bad instruction" diff --git a/lvtrun/src/Parsing/Code.hs b/lvtrun/src/Parsing/Code.hs index 12f992d..65ce027 100644 --- a/lvtrun/src/Parsing/Code.hs +++ b/lvtrun/src/Parsing/Code.hs @@ -12,7 +12,6 @@ module Parsing.Code where import Data.Int (Int64) -import Control.Monad (when) import Control.Exception (throw) import qualified Data.ByteString.Lazy as BSL @@ -26,29 +25,29 @@ diviseBytes bytes | BSL.length bytes == 0 = [] | otherwise = code : diviseBytes rest2 where - (size, rest) = getLEB128ToI64 bytes - (code, rest2) = BSL.splitAt size rest + (sze, rest) = getLEB128ToI64 bytes + (code, rest2) = BSL.splitAt sze rest createLocal :: LocalIdx -> TypeName -> Local createLocal idx typee = Local {lcIdx = idx, lcType = typee} extractLocal :: Int64 -> BSL.ByteString -> ([Local], BSL.ByteString) -extractLocal id bytes +extractLocal idtf bytes | BSL.length bytes == 0 = throw $ WasmError "extractLocal: bad section" - | otherwise = (locals, BSL.drop 1 rest) + | otherwise = (lcals, BSL.drop 1 rest) where (nb, rest) = getLEB128ToI64 bytes typee = getTypeFromByte (head (BSL.unpack (BSL.take 1 rest))) - locals = map (\x -> createLocal (fromIntegral id) typee) [0..nb - 1] + lcals = map (\_ -> createLocal (fromIntegral idtf) typee) [0..nb - 1] extractLocals :: Int64 -> Int64 -> BSL.ByteString -> ([Local], BSL.ByteString) -extractLocals id idMax bytes - | id >= idMax = ([], bytes) +extractLocals idtf idMax bytes + | idtf >= idMax = ([], bytes) | BSL.length bytes == 0 = ([], bytes) - | otherwise = (local ++ locals, rest2) + | otherwise = (local ++ lcals, rest2) where - (local, rest) = extractLocal id bytes - (locals, rest2) = extractLocals (id + 1) idMax rest + (local, rest) = extractLocal idtf bytes + (lcals, rest2) = extractLocals (idtf + 1) idMax rest ------------------------- @@ -80,9 +79,9 @@ parseFunctions _ [] = throw $ WasmError "parseFunctions: bad section" parseFunctions (x:xs) (y:ys) = parseFunction x y : parseFunctions xs ys getFuncCode :: Section -> [Function] -> [Function] -getFuncCode (Section CodeID _ content) functions = - parseFunctions funcCodes functions +getFuncCode (Section CodeID _ cntent) fctns = + parseFunctions funcCodes fctns where - (nbFunc, rest) = getLEB128ToI64 content + (_, rest) = getLEB128ToI64 cntent funcCodes = diviseBytes rest getFuncCode _ _ = throw $ WasmError "getFuncCode: bad section" diff --git a/lvtrun/src/Parsing/Exports.hs b/lvtrun/src/Parsing/Exports.hs index f2617d7..9313c77 100644 --- a/lvtrun/src/Parsing/Exports.hs +++ b/lvtrun/src/Parsing/Exports.hs @@ -13,7 +13,6 @@ where import Data.Char (chr) import Data.Word (Word8) -import Control.Monad (when) import Data.Int (Int64, Int32) import Control.Exception (throw) import qualified Data.ByteString.Lazy as Bs @@ -22,40 +21,33 @@ import Types import Leb128 (getLEB128ToI64, getLEB128ToI32) import Errors (CustomException(WasmError)) -isExportValid :: Word8 -> Bool -isExportValid 0x00 = True -isExportValid 0x01 = True -isExportValid 0x02 = True -isExportValid 0x03 = True -isExportValid _ = False - getExportNb :: Bs.ByteString -> (Int64, Bs.ByteString) -getExportNb content = getLEB128ToI64 content +getExportNb cntent = getLEB128ToI64 cntent word8ToString :: [Word8] -> String word8ToString = map (chr . fromIntegral) createExport :: [Word8] -> Word8 -> FuncIdx -> Export -createExport name 0x00 idx = Export (word8ToString name) (ExportFunc idx) -createExport name 0x01 idx = Export (word8ToString name) (ExportTable idx) -createExport name 0x02 idx = Export (word8ToString name) (ExportMemory idx) -createExport name 0x03 idx = Export (word8ToString name) (ExportGlobal idx) +createExport nme 0x00 idx = Export (word8ToString nme) (ExportFunc idx) +createExport nme 0x01 idx = Export (word8ToString nme) (ExportTable idx) +createExport nme 0x02 idx = Export (word8ToString nme) (ExportMemory idx) +createExport nme 0x03 idx = Export (word8ToString nme) (ExportGlobal idx) createExport _ _ _ = throw $ WasmError "createExport: bad export" parseExports :: Int32 -> Int64 -> Bs.ByteString -> [Export] -parseExports idx maxIdx content +parseExports idx maxIdx cntent | idx >= (fromIntegral maxIdx) = [] - | Bs.length content == 0 = [] + | Bs.length cntent == 0 = [] | otherwise = export : parseExports (idx + 1) maxIdx rest3 where - (nameLen, rest) = getLEB128ToI64 content - (name, rest2) = Bs.splitAt nameLen rest + (nameLen, rest) = getLEB128ToI64 cntent + (nme, rest2) = Bs.splitAt nameLen rest exportType = head (Bs.unpack rest2) (exportValue, rest3) = getLEB128ToI32 (Bs.drop 1 rest2) - export = createExport (Bs.unpack name) exportType exportValue + export = createExport (Bs.unpack nme) exportType exportValue getExports :: Section -> [Export] -getExports (Section ExportID _ content) = parseExports 0 exprtsNb rest +getExports (Section ExportID _ cntent) = parseExports 0 exprtsNb rest where - (exprtsNb, rest) = getExportNb content + (exprtsNb, rest) = getExportNb cntent getExports _ = throw $ WasmError "getExports: bad section" diff --git a/lvtrun/src/Parsing/FuncTypes.hs b/lvtrun/src/Parsing/FuncTypes.hs index 29110b5..e6d0509 100644 --- a/lvtrun/src/Parsing/FuncTypes.hs +++ b/lvtrun/src/Parsing/FuncTypes.hs @@ -20,29 +20,29 @@ import Leb128 (getLEB128ToI64) import Errors (CustomException(..)) getVectorSize :: Bs.ByteString -> (Int64, Bs.ByteString) -getVectorSize content = getLEB128ToI64 content +getVectorSize cntent = getLEB128ToI64 cntent extractTypes :: (Int64, Bs.ByteString) -> ([TypeName], Bs.ByteString) -extractTypes (0, content) = ([], content) -extractTypes (idx, content) = - (getTypeFromByte (head $ Bs.unpack content) : types, rest) - where (types, rest) = extractTypes (idx - 1, Bs.drop 1 content) +extractTypes (0, cntent) = ([], cntent) +extractTypes (idx, cntent) = + (getTypeFromByte (head $ Bs.unpack cntent) : typs, rest) + where (typs, rest) = extractTypes (idx - 1, Bs.drop 1 cntent) parseFuncType :: Int32 -> Bs.ByteString -> (FuncType, Bs.ByteString) -parseFuncType id content = (FuncType id params results, rest2) +parseFuncType idtfier cntent = (FuncType idtfier prams res, rest2) where - (params, rest) = extractTypes (getVectorSize content) - (results, rest2) = extractTypes (getVectorSize rest) + (prams, rest) = extractTypes (getVectorSize cntent) + (res, rest2) = extractTypes (getVectorSize rest) parseFuncTypes :: Int32 -> Int64 -> Bs.ByteString -> [FuncType] -parseFuncTypes idx maxIdx content +parseFuncTypes idx maxIdx cntent | idx >= (fromIntegral maxIdx) = [] - | head (Bs.unpack content) == 0x60 = - funcType : parseFuncTypes (idx + 1) maxIdx rest + | head (Bs.unpack cntent) == 0x60 = + fnType : parseFuncTypes (idx + 1) maxIdx rest | otherwise = throw $ WasmError "ParseFuncTypes: 0x60 expected for function" - where (funcType, rest) = parseFuncType idx (Bs.drop 1 content) + where (fnType, rest) = parseFuncType idx (Bs.drop 1 cntent) getFuncTypes :: Section -> [FuncType] -getFuncTypes (Section TypeID _ content) = parseFuncTypes 0 vecSize rest - where (vecSize, rest) = getLEB128ToI64 content +getFuncTypes (Section TypeID _ cntent) = parseFuncTypes 0 vecSize rest + where (vecSize, rest) = getLEB128ToI64 cntent getFuncTypes _ = throw $ WasmError "getFuncTypes: bad section" diff --git a/lvtrun/src/Parsing/Functions.hs b/lvtrun/src/Parsing/Functions.hs index 1bb7c4b..bf6364c 100644 --- a/lvtrun/src/Parsing/Functions.hs +++ b/lvtrun/src/Parsing/Functions.hs @@ -20,19 +20,20 @@ import Errors import Leb128 parseFunctionsIndex :: Int32 -> Int64 -> BSL.ByteString -> [Function] -parseFunctionsIndex idx maxIdx content - | idx > (fromIntegral maxIdx) = [] - | BSL.length content == 0 = [] +parseFunctionsIndex idtfier maxIdx cntent + | idtfier > (fromIntegral maxIdx) = [] + | BSL.length cntent == 0 = [] | otherwise = Function { - funcType = fromIntegral typeIdx, - funcIdx = idx, - body = [] - } : parseFunctionsIndex (idx + 1) maxIdx rest - where (typeIdx, rest) = getLEB128ToI32 content + funcType = typeIdx, + funcIdx = idtfier, + body = [], + locals = [] + } : parseFunctionsIndex (idtfier + 1) maxIdx rest + where (typeIdx, rest) = getLEB128ToI32 cntent getFunctions :: Section -> [Function] -getFunctions (Section FunctionID _ content) = +getFunctions (Section FunctionID _ cntent) = parseFunctionsIndex 0 vecSize rest - where (vecSize, rest) = getLEB128ToI64 content + where (vecSize, rest) = getLEB128ToI64 cntent getFunctions _ = throw $ WasmError "getFunctions: bad section" diff --git a/lvtrun/src/Parsing/Global.hs b/lvtrun/src/Parsing/Global.hs index 81c6a76..7ebbee9 100644 --- a/lvtrun/src/Parsing/Global.hs +++ b/lvtrun/src/Parsing/Global.hs @@ -44,37 +44,37 @@ parseMutability 0x01 = Var parseMutability _ = throw $ WasmError "ParseMutability: bad mutability" getHexaIndex :: BSL.ByteString -> Int64 -> Int64 -getHexaIndex content idx - | idx >= (fromIntegral $ BSL.length content) = +getHexaIndex cntent idx + | idx >= BSL.length cntent = throw $ WasmError "GetHexaIndex: no 0x0b found" - | (head $ BSL.unpack $ BSL.drop (fromIntegral idx) content) == 0x0b = idx - | otherwise = getHexaIndex content (idx + 1) + | (head $ BSL.unpack $ BSL.drop idx cntent) == 0x0b = idx + | otherwise = getHexaIndex cntent (idx + 1) extractExpression :: BSL.ByteString -> (BSL.ByteString, BSL.ByteString) -extractExpression content = (expression, rest) +extractExpression cntent = (expression, rest) where - idx = getHexaIndex content 0 - expression = BSL.take (fromIntegral (idx + 1)) content - rest = BSL.drop (fromIntegral (idx + 1)) content + idx = getHexaIndex cntent 0 + expression = BSL.take (idx + 1) cntent + rest = BSL.drop (idx + 1) cntent parseGlobal :: BSL.ByteString -> (Global, BSL.ByteString) -parseGlobal content = (Global globalType mutability instructions, rest) +parseGlobal cntent = (Global gblType mtability instructions, rest) where - globalType = getTypeFromByte (head $ BSL.unpack content) - mutability = parseMutability (head $ BSL.unpack $ BSL.drop 1 content) - (expression, rest) = extractExpression (BSL.drop 2 content) + gblType = getTypeFromByte (head $ BSL.unpack cntent) + mtability = parseMutability (head $ BSL.unpack $ BSL.drop 1 cntent) + (expression, rest) = extractExpression (BSL.drop 2 cntent) instructions = parseInstructions expression parseGlobals :: Int64 -> Int64 -> BSL.ByteString -> [Global] -parseGlobals idx maxIdx content +parseGlobals idx maxIdx cntent | idx >= maxIdx = [] | otherwise = global : parseGlobals (idx + 1) maxIdx rest where - (global, rest) = parseGlobal content + (global, rest) = parseGlobal cntent getGlobals :: Section -> [Global] -getGlobals (Section GlobalID _ content) = +getGlobals (Section GlobalID _ cntent) = parseGlobals 0 vecSize rest where - (vecSize, rest) = getLEB128ToI64 content + (vecSize, rest) = getLEB128ToI64 cntent getGlobals _ = throw $ WasmError "getGlobals: bad section" diff --git a/lvtrun/src/Parsing/Memory.hs b/lvtrun/src/Parsing/Memory.hs index 455681f..1cc4faa 100644 --- a/lvtrun/src/Parsing/Memory.hs +++ b/lvtrun/src/Parsing/Memory.hs @@ -18,28 +18,28 @@ import Leb128 (getLEB128ToI32) import Errors (CustomException(..)) parseMinMax :: BS.ByteString -> Memory -parseMinMax content +parseMinMax cntent | endBs /= BS.empty = throw $ WasmError "parseMinMax: bad memory section" - | otherwise = Limit {lMin = min, lMax = Just max} + | otherwise = Limit {lMin = memMin, lMax = Just memMax} where - (min, rest) = getLEB128ToI32 content - (max, endBs) = getLEB128ToI32 rest + (memMin, rest) = getLEB128ToI32 cntent + (memMax, endBs) = getLEB128ToI32 rest parseMin :: BS.ByteString -> Memory -parseMin content +parseMin cntent | endBs /= BS.empty = throw $ WasmError "parseMin: bad memory section" - | otherwise = Limit {lMin = min, lMax = Nothing} + | otherwise = Limit {lMin = memMin, lMax = Nothing} where - (min, endBs) = getLEB128ToI32 content + (memMin, endBs) = getLEB128ToI32 cntent parseMemory :: BS.ByteString -> Memory -parseMemory content - | head (BS.unpack content) == 0x01 = parseMinMax (BS.drop 1 content) - | head (BS.unpack content) == 0x00 = parseMin (BS.drop 1 content) +parseMemory cntent + | head (BS.unpack cntent) == 0x01 = parseMinMax (BS.drop 1 cntent) + | head (BS.unpack cntent) == 0x00 = parseMin (BS.drop 1 cntent) | otherwise = throw $ WasmError "parseMemory: bad memory section" getMemories :: Section -> Memory -getMemories (Section MemoryID _ content) - | head (BS.unpack content) == 0x01 = parseMemory (BS.drop 1 content) +getMemories (Section MemoryID _ cntent) + | head (BS.unpack cntent) == 0x01 = parseMemory (BS.drop 1 cntent) | otherwise = throw $ WasmError "getMemories: v1 allow 1 memory only" getMemories _ = throw $ WasmError "getMemories: bad memory section" diff --git a/lvtrun/src/Parsing/Sections.hs b/lvtrun/src/Parsing/Sections.hs index 8fa167e..92e5fa2 100644 --- a/lvtrun/src/Parsing/Sections.hs +++ b/lvtrun/src/Parsing/Sections.hs @@ -44,11 +44,11 @@ getSectionId :: BSL.ByteString -> SectionID getSectionId bytes = getSectionId' (head (BSL.unpack bytes)) extractSection :: BSL.ByteString -> (Section, BSL.ByteString) -extractSection bytes = (Section sectionId (fromIntegral size) content, rest2) +extractSection bytes = (Section sectionId (fromIntegral sze) cntent, rest2) where sectionId = getSectionId bytes - (size, rest) = getLEB128ToI64 (BSL.drop 1 bytes) - (content, rest2) = BSL.splitAt size rest + (sze, rest) = getLEB128ToI64 (BSL.drop 1 bytes) + (cntent, rest2) = BSL.splitAt sze rest extractSections :: BSL.ByteString -> [Section] extractSections bytes @@ -65,6 +65,6 @@ getSections bytes = header : sections getSectionWithId :: [Section] -> SectionID -> Section getSectionWithId [] _ = throw (WasmError "No section with this id") -getSectionWithId (x:xs) id - | identifier x == id = x - | otherwise = getSectionWithId xs id +getSectionWithId (x:xs) idtfier + | identifier x == idtfier = x + | otherwise = getSectionWithId xs idtfier diff --git a/lvtrun/src/Run/Functions.hs b/lvtrun/src/Run/Functions.hs index b85f113..ed99d65 100644 --- a/lvtrun/src/Run/Functions.hs +++ b/lvtrun/src/Run/Functions.hs @@ -31,9 +31,9 @@ getStartFunctionId (x:xs) getFunctionFromId :: Int32 -> [Function] -> Function getFunctionFromId _ [] = throw $ RuntimeError "getFunctionFromId: bad id" -getFunctionFromId id (x:xs) - | funcIdx x == id = x - | otherwise = getFunctionFromId id xs +getFunctionFromId idtfier (x:xs) + | funcIdx x == idtfier = x + | otherwise = getFunctionFromId idtfier xs getStartFunction :: [Export] -> [Function] -> Function getStartFunction exports functions = @@ -41,6 +41,6 @@ getStartFunction exports functions = getFuncTypeFromId :: Int32 -> [FuncType] -> FuncType getFuncTypeFromId _ [] = throw $ RuntimeError "getFuncTypeFromId: bad id" -getFuncTypeFromId id (x:xs) - | typeId x == id = x - | otherwise = getFuncTypeFromId id xs +getFuncTypeFromId idtfier (x:xs) + | typeId x == idtfier = x + | otherwise = getFuncTypeFromId idtfier xs diff --git a/lvtrun/src/Run/Types.hs b/lvtrun/src/Run/Types.hs index 737efb7..f86b905 100644 --- a/lvtrun/src/Run/Types.hs +++ b/lvtrun/src/Run/Types.hs @@ -67,7 +67,7 @@ createVm wasmMod = VM { vmStack = [], goToLabel :: CurrentExec -> LabelIdx -> CurrentExec goToLabel cEx labelIdx = - cEx {ceInstIdx = fromIntegral (getLabelOpIdx cEx labelIdx)} + cEx {ceInstIdx = (getLabelOpIdx cEx labelIdx)} getLabelOpIdx :: CurrentExec -> LabelIdx -> Int getLabelOpIdx cEx labelIdx diff --git a/lvtrun/src/Run/Vm.hs b/lvtrun/src/Run/Vm.hs index 9b7c161..13b6708 100644 --- a/lvtrun/src/Run/Vm.hs +++ b/lvtrun/src/Run/Vm.hs @@ -87,17 +87,17 @@ execSetLocal cEx localIdx = cEx { ceStack = newStack, ceLocals = setLocalWithId 0 (ceLocals cEx) value localIdx} where (value, newStack) = stackPop (ceStack cEx) -execBrIf :: CurrentExec -> CurrentExec -execBrIf cEx@(CurrentExec {ceStack = stack}) = +execBrIf :: CurrentExec -> LabelIdx -> CurrentExec +execBrIf cEx@(CurrentExec {ceStack = stack}) lbIdx = case (stackTop stack) of - I_32 0 -> cEx - I_32 _ -> cEx { ceInstIdx = (ceInstIdx cEx) } - _ -> throw $ RuntimeError "exec brIf: bad type" + I_32 0 -> incrementInstIdx cEx + I_32 1 -> goToLabel cEx lbIdx + _ -> throw $ RuntimeError "execBrIf: bad type" execCall :: VM -> CurrentExec -> FuncIdx -> CurrentExec -execCall vm cEx funcIdx = cEx { ceStack = newStack } +execCall vm cEx fnIdx = cEx { ceStack = newStack } where - newVm = execFunctionWithIdx vm funcIdx currentStack + newVm = execFunctionWithIdx vm fnIdx currentStack newStack = pushResults currentStack (vmStack newVm) res currentStack = ceStack cEx res = ceResults (currentExec newVm) @@ -119,7 +119,7 @@ getElseIndex :: CurrentExec -> Int getElseIndex cEx = getElseIndex' (drop (ceInstIdx cEx) (ceInstructions cEx)) 0 executeElse :: CurrentExec -> CurrentExec -executeElse cEx@(CurrentExec {ceStack = stack}) = +executeElse cEx = case doesElseExist cEx of False -> cEx True -> cEx { ceInstIdx = getElseIndex cEx } @@ -138,6 +138,7 @@ execI32GtS cEx@(CurrentExec {ceStack = stack}) = ([I_32 val2, I_32 val1], newStack) -> case (val1 > val2) of True -> cEx { ceStack = stackPush newStack (I_32 1) } False -> cEx { ceStack = stackPush newStack (I_32 0) } + _ -> throw $ RuntimeError "exec I32GtS: bad type" execI32GeS :: CurrentExec -> CurrentExec execI32GeS cEx@(CurrentExec {ceStack = stack}) = @@ -145,6 +146,7 @@ execI32GeS cEx@(CurrentExec {ceStack = stack}) = ([I_32 val2, I_32 val1], newStack) -> case (val1 >= val2) of True -> cEx { ceStack = stackPush newStack (I_32 1) } False -> cEx { ceStack = stackPush newStack (I_32 0) } + _ -> throw $ RuntimeError "exec I32GeS: bad type" execI32LtS :: CurrentExec -> CurrentExec execI32LtS cEx@(CurrentExec {ceStack = stack}) = @@ -152,6 +154,7 @@ execI32LtS cEx@(CurrentExec {ceStack = stack}) = ([I_32 val2, I_32 val1], newStack) -> case (val1 < val2) of True -> cEx { ceStack = stackPush newStack (I_32 1) } False -> cEx { ceStack = stackPush newStack (I_32 0) } + _ -> throw $ RuntimeError "exec I32LtS: bad type" execI32LeS :: CurrentExec -> CurrentExec execI32LeS cEx@(CurrentExec {ceStack = stack}) = @@ -159,14 +162,16 @@ execI32LeS cEx@(CurrentExec {ceStack = stack}) = ([I_32 val2, I_32 val1], newStack) -> case (val1 <= val2) of True -> cEx { ceStack = stackPush newStack (I_32 1) } False -> cEx { ceStack = stackPush newStack (I_32 0) } + _ -> throw $ RuntimeError "exec I32LeS: bad type" execI32GtU :: CurrentExec -> CurrentExec execI32GtU cEx@(CurrentExec {ceStack = stack}) = case (stackPopN stack 2) of ([I_32 val2, I_32 val1], newStack) -> - case ((fromIntegral val1) > (fromIntegral val2)) of + case (val2 > val1) of True -> cEx { ceStack = stackPush newStack (I_32 1) } False -> cEx { ceStack = stackPush newStack (I_32 0) } + _ -> throw $ RuntimeError "exec I32GtU: bad type" incrementBlockIndent :: CurrentExec -> CurrentExec incrementBlockIndent cEx = cEx { crBlockIndents = (crBlockIndents cEx) + 1 } @@ -175,7 +180,7 @@ execBr :: CurrentExec -> LabelIdx -> CurrentExec execBr cEx labelIdx = goToLabel cEx labelIdx execOpCode :: VM -> CurrentExec -> Instruction -> CurrentExec -execOpCode _ cEx (Unreachable) = throw $ RuntimeError "execOpCode: unreachable" +execOpCode _ _ (Unreachable) = throw $ RuntimeError "execOpCode: unreachable" execOpCode _ cEx (End) = decrementBlockIdx cEx execOpCode _ cEx (Return) = decrementBlockIdx cEx execOpCode _ cEx (I32Const val) = execI32Const cEx val @@ -187,8 +192,8 @@ execOpCode _ cEx (I32Mul) = execI32Mul cEx execOpCode _ cEx (I32Divs) = execI32Divs cEx execOpCode _ cEx (GetLocal localIdx) = execGetLocal cEx localIdx execOpCode _ cEx (SetLocal localIdx) = execSetLocal cEx localIdx -execOpCode _ cEx (BrIf labelIdx) = execBrIf cEx -execOpCode vm cEx (Call funcIdx) = execCall vm cEx funcIdx +execOpCode _ cEx (BrIf labelIdx) = execBrIf cEx labelIdx +execOpCode vm cEx (Call fnIdx) = execCall vm cEx fnIdx execOpCode _ cEx (If) = execIf cEx execOpCode _ cEx (I32Gts) = execI32GtS cEx execOpCode _ cEx (I32Ges) = execI32GeS cEx @@ -198,8 +203,8 @@ execOpCode _ cEx (I32Gtu) = execI32GtU cEx execOpCode _ cEx (Block _) = incrementBlockIndent (addLabel cEx) execOpCode _ cEx (Br labelIdx) = execBr cEx labelIdx execOpCode _ cEx (Loop) = incrementBlockIndent (addLabel cEx) -execOpCode _ cEx (Else) = throw $ RuntimeError "elseWithoutIf" -execOpCode _ cEx _ = throw $ RuntimeError "execOpCode: not implemented" +execOpCode _ _ (Else) = throw $ RuntimeError "elseWithoutIf" +execOpCode _ _ _ = throw $ RuntimeError "execOpCode: not implemented" execOpCodes :: VM -> [Instruction] -> CurrentExec execOpCodes vm [] = currentExec vm @@ -222,10 +227,10 @@ execFunction vm = vm { currentExec = newCEx, vmStack = stackWithRes } (ceResults newCEx) execFunctionWithIdx :: VM -> FuncIdx -> Stack -> VM -execFunctionWithIdx vm funcIdx currentStack = +execFunctionWithIdx vm fnIdx currentStack = execFunction vm { currentExec = cexec } where - function = getFunctionFromId funcIdx (functions (wasmModule vm)) + function = getFunctionFromId fnIdx (functions (wasmModule vm)) funcTypee = getFuncTypeFromId (funcType function) (types (wasmModule vm)) (newLocals, newStack) = initLocals (locals function) (params funcTypee) currentStack @@ -234,9 +239,9 @@ execFunctionWithIdx vm funcIdx currentStack = ceParams = params funcTypee, ceResults = results funcTypee} runMain :: VM -> FuncIdx -> Stack -runMain vm funcIdx = pushResults[](vmStack newVm)(ceResults(currentExec newVm)) +runMain vm fnIdx = pushResults[](vmStack newVm)(ceResults(currentExec newVm)) where - function = getFunctionFromId funcIdx (functions (wasmModule vm)) + function = getFunctionFromId fnIdx (functions (wasmModule vm)) funcTypee = getFuncTypeFromId (funcType function) (types (wasmModule vm)) cexec = createEmptyExec { ceLocals = createEmptyLocals [] (locals function), diff --git a/lvtrun/src/Types.hs b/lvtrun/src/Types.hs index 121c239..91bad3c 100644 --- a/lvtrun/src/Types.hs +++ b/lvtrun/src/Types.hs @@ -132,9 +132,6 @@ data Instruction = | MemorySize | MemoryGrow deriving (Eq) ---IF/ELSE ---LOOP ---BR instance Show Instruction where show Unreachable = "\n\t\t\t\tunreachable" @@ -176,6 +173,7 @@ instance Show Instruction where show End = "\n\t\t\t\tend" show (Block blockType) = "\n\t\t\t\tblock " ++ (show blockType) show (Loop) = "\n\t\t\t\tloop" + show (Else) = "\n\t\t\t\telse" -- Module section From 8ee878c3c586d805c5b1df07c1e61b0520c4c4e7 Mon Sep 17 00:00:00 2001 From: tenshi Date: Mon, 15 Jan 2024 00:38:08 +0100 Subject: [PATCH 2/2] fix unused and shadowing warnings --- lvtrun/src/Parsing/Functions.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lvtrun/src/Parsing/Functions.hs b/lvtrun/src/Parsing/Functions.hs index bf6364c..40b30b5 100644 --- a/lvtrun/src/Parsing/Functions.hs +++ b/lvtrun/src/Parsing/Functions.hs @@ -27,8 +27,7 @@ parseFunctionsIndex idtfier maxIdx cntent Function { funcType = typeIdx, funcIdx = idtfier, - body = [], - locals = [] + body = [], locals = [] } : parseFunctionsIndex (idtfier + 1) maxIdx rest where (typeIdx, rest) = getLEB128ToI32 cntent