Merge branch 'dev' of github.com:X-R-G-B/Leviator into dev

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"

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"

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"

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"

lvtrun/src/Parsing/Functions.hs

@@ -20,19 +20,19 @@ 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"

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"

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"

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

lvtrun/src/Run/Functions.hs

@@ -31,16 +31,16 @@ 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 =
   getFunctionFromId (getStartFunctionId 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

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