refactor + good global parsing

lvtrun/app/IO.hs

@@ -0,0 +1,18 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- IO
+-}
+
+module IO
+(
+  getFileContent
+)
+where
+
+import qualified Data.ByteString.Lazy as BSL (readFile)
+import Types
+
+getFileContent :: String -> IO FileContent
+getFileContent path = BSL.readFile path

lvtrun/app/WasmMod/Leb128.hs → lvtrun/app/Leb128.hs

@@ -5,16 +5,17 @@
 -- Leb128
 -}
 
-module WasmMod.Leb128
+module Leb128
   (
     getLEB128,
-    extractLEB128
+    extractLEB128,
+    extractLEB1282,
   )
 where
 
 import Data.Binary.Get
 import Data.Bits
-import Data.Int (Int64)
+import Data.Int (Int64, Int32)
 import qualified Data.ByteString.Lazy as BS (ByteString, drop)
 
 getLEB128 :: Get Int
@@ -43,3 +44,19 @@ extractLEB128 :: BS.ByteString -> (Int64, BS.ByteString)
 extractLEB128 bytes = do
     let (value, size) = runGet extractLEB128' bytes
     (value, BS.drop size bytes)
+
+
+extractLEB1282' :: Get (Int32, Int64)
+extractLEB1282' = do
+  byte <- getWord8
+  let value = fromIntegral (byte .&. 0x7F)
+  case byte `testBit` 7 of
+    True -> do
+      (next, size) <- extractLEB1282'
+      return (value .|. (next `shiftL` 7), size + 1)
+    False -> return (value, 1)
+
+extractLEB1282 :: BS.ByteString -> (Int32, BS.ByteString)
+extractLEB1282 bytes = do
+    let (value, size) = runGet extractLEB1282' bytes
+    (value, BS.drop size bytes)

lvtrun/app/Loader.hs

@@ -0,0 +1,20 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Loader
+-}
+
+module Loader
+(
+  loadModule
+)
+where
+
+import Parsing.Parser
+import Types
+import IO
+
+loadModule :: String -> IO WasmModule
+loadModule path = getFileContent path >>= \bytes ->
+  return $ parseModule bytes

lvtrun/app/Main.hs

@@ -8,11 +8,11 @@
 module Main (main) where
 
 import Control.Exception (try)
-import WasmMod.Module
 import Errors
+import Loader
 
 main :: IO ()
-main = try (loadModule "./test/test.wasm") >>= \result ->
+main = try (loadModule "./test/simple.wasm") >>= \result ->
     case result of
         Left err -> handleException err
         Right wasmMod -> print wasmMod

lvtrun/app/WasmMod/Sections/Types.hs → lvtrun/app/Parsing/FuncTypes.hs

@@ -5,58 +5,45 @@
 -- Types
 -}
 
-module WasmMod.Sections.Types
+module Parsing.FuncTypes
   (
-    parseTypes,
-    Type(..),
-    FuncType(..)
+    getFuncTypes
   )
 where
 
 import qualified Data.ByteString.Lazy as Bs
 import Control.Exception (throw)
-import Data.Int (Int64)
+import Data.Int (Int64, Int32)
 import Data.Word (Word8)
 
-import WasmMod.Sections
-import WasmMod.Leb128
+import Leb128
 import Errors
-import Types (Type(..), getTypeFromByte)
-
-data FuncType = FuncType {
-  typeId :: Int,
-  params :: [Type],
-  results :: [Type]
-}
-
-instance Show FuncType where
-  show funcType = "(type " ++ (show $ typeId funcType) ++ " (func " ++
-    (show $ params funcType) ++ ") " ++ (show $ results funcType) ++ ")\n"
+import Types
 
 getVectorSize :: Bs.ByteString -> (Int64, Bs.ByteString)
 getVectorSize content = extractLEB128 content
 
-extractTypes :: (Int64, Bs.ByteString) -> ([Type], Bs.ByteString)
+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)
 
-parseFuncType :: Int -> Bs.ByteString -> (FuncType, Bs.ByteString)
+parseFuncType :: Int32 -> Bs.ByteString -> (FuncType, Bs.ByteString)
 parseFuncType id content = do
   let (params, rest) = extractTypes (getVectorSize content)
   let (results, rest2) = extractTypes (getVectorSize rest)
   ((FuncType id params results), rest2)
 
-parseFuncTypes :: Int -> Int64 -> Bs.ByteString -> [FuncType]
+parseFuncTypes :: Int32 -> Int64 -> Bs.ByteString -> [FuncType]
 parseFuncTypes idx maxIdx content
   | idx >= (fromIntegral maxIdx) = []
   | head (Bs.unpack content) == 0x60 = do
     let (funcType, rest) = parseFuncType idx (Bs.drop 1 content)
     funcType : parseFuncTypes (idx + 1) maxIdx rest
   | otherwise = throw $ WasmError "ParseFuncTypes: 0x60 expected for function"
 
-parseTypes :: Section -> [FuncType]
-parseTypes (Section TypeID _ content) = do
+getFuncTypes :: Section -> [FuncType]
+getFuncTypes (Section TypeID _ content) = do
   let (vecSize, rest) = extractLEB128 content
   parseFuncTypes 0 vecSize rest
-parseTypes _ = throw $ WasmError "ParseTypes: bad section"
+getFuncTypes _ = throw $ WasmError "getFuncTypes: bad section"

lvtrun/app/Parsing/Global.hs

@@ -0,0 +1,151 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Global
+-}
+
+module Parsing.Global
+  (
+    getGlobals,
+  )
+where
+
+import qualified Data.ByteString.Lazy as BSL
+import Control.Exception (throw)
+import Control.Monad (when)
+import Data.Word (Word8)
+import Data.Int (Int64)
+
+import Leb128
+import Types
+import Errors
+
+extractOpCode :: BSL.ByteString -> ([Word8], Int64, BSL.ByteString)
+extractOpCode bytes
+  | (head $ BSL.unpack bytes) == 0x00 = ([0x00], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x01 = ([0x01], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x0f = ([0x0f], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x10 = ([0x10], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x41 = ([0x41], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x42 = ([0x42], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x43 = ([0x43], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x44 = ([0x44], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x28 = ([0x28], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x29 = ([0x29], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x36 = ([0x36], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x37 = ([0x37], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x37 = ([0x37], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x20 = ([0x20], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x21 = ([0x21], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x23 = ([0x23], 1, BSL.drop 1 bytes)
+  | (head $ BSL.unpack bytes) == 0x24 = ([0x24], 1, BSL.drop 1 bytes)
+  | (BSL.unpack $ BSL.take 2 bytes) == [0x3f, 0x00] = ([0x3f, 0x00], 2, BSL.drop 2 bytes)
+  | (BSL.unpack $ BSL.take 2 bytes) == [0x40, 0x00] = ([0x40, 0x00], 2, BSL.drop 2 bytes)
+  | otherwise = throw $ WasmError "ExtractOpCode: bad opcode"
+
+createInstruction :: OpCode -> BSL.ByteString -> (Instruction, BSL.ByteString)
+createInstruction [0x01] bytes = (Unreachable, bytes)
+createInstruction [0x01] bytes = (Nop, bytes)
+createInstruction [0x0f] bytes = (Return, bytes)
+createInstruction [0x10] bytes = do
+  let (value, rest) = extractLEB1282 bytes
+  (Call value, rest)
+createInstruction [0x41] bytes = do
+  let (value, rest) = extractLEB1282 bytes
+  (I32Const value, rest)
+createInstruction [0x42] bytes = do
+  let (value, rest) = extractLEB128 bytes
+  (I64Const value, rest)
+createInstruction [0x43] bytes = do
+  let (value, rest) = extractLEB128 bytes
+  (F32Const (fromIntegral value), rest)
+createInstruction [0x44] bytes = do
+  let (value, rest) = extractLEB128 bytes
+  (F64Const (fromIntegral value), rest)
+createInstruction [0x28] bytes = do
+  let (align, rest) = extractLEB1282 bytes
+  let (offset, rest2) = extractLEB1282 rest
+  (I32Load (MemArg align offset), rest2)
+createInstruction [0x29] bytes = do
+  let (align, rest) = extractLEB1282 bytes
+  let (offset, rest2) = extractLEB1282 rest
+  (I64Load (MemArg align offset), rest2)
+createInstruction [0x36] bytes = do
+  let (align, rest) = extractLEB1282 bytes
+  let (offset, rest2) = extractLEB1282 rest
+  (I32Store (MemArg align offset), rest2)
+createInstruction [0x37] bytes = do
+  let (align, rest) = extractLEB1282 bytes
+  let (offset, rest2) = extractLEB1282 rest
+  (I64Store (MemArg align offset), rest2)
+createInstruction [0x20] bytes = do
+  let (value, rest) = extractLEB1282 bytes
+  (GetLocal value, rest)
+createInstruction [0x24] bytes = do
+  let (value, rest) = extractLEB1282 bytes
+  (SetLocal value, rest)
+createInstruction [0x23] bytes = do
+  let (value, rest) = extractLEB1282 bytes
+  (GetGlobal value, rest)
+createInstruction [0x21] bytes = do
+  let (value, rest) = extractLEB1282 bytes
+  (SetGlobal value, rest)
+createInstruction [0x3f, 0x00] bytes = (MemorySize, bytes)
+createInstruction [0x40, 0x00] bytes = (MemoryGrow, bytes)
+createInstruction _ _ = throw $ WasmError "CreateInstruction: bad instruction"
+
+parseInstruction :: BSL.ByteString -> (Instruction, BSL.ByteString)
+parseInstruction bytes
+  | BSL.length bytes == 0 = throw $ WasmError "ParseInstruction: no instruction"
+  | otherwise = do
+    let (opCode, nbParams, rest) = extractOpCode bytes
+    let (instruction, rest2) = createInstruction opCode rest
+    (instruction, rest2)
+
+parseInstructions :: BSL.ByteString -> [Instruction]
+parseInstructions bytes
+  | BSL.length bytes == 0 = []
+  | head (BSL.unpack bytes) == 0x0b = []
+  | otherwise = do
+    let (instruction, rest) = parseInstruction bytes
+    instruction : parseInstructions rest
+
+parseMutability :: Word8 -> Mutability
+parseMutability 0x00 = Const
+parseMutability 0x01 = Var
+parseMutability _ = throw $ WasmError "ParseMutability: bad mutability"
+
+getHexaIndex :: BSL.ByteString -> Int64 -> Int64
+getHexaIndex content idx
+  | idx >= (fromIntegral $ BSL.length content) = throw $ WasmError "GetHexaIndex: no 0x0b found"
+  | (head $ BSL.unpack $ BSL.drop (fromIntegral idx) content) == 0x0b = idx
+  | otherwise = getHexaIndex content (idx + 1)
+
+extractExpression :: BSL.ByteString -> (BSL.ByteString, BSL.ByteString)
+extractExpression content = do
+    let idx = getHexaIndex content 0
+    let expression = BSL.take (fromIntegral (idx + 1)) content
+    let rest = BSL.drop (fromIntegral (idx + 1)) content
+    (expression, rest)
+
+parseGlobal :: BSL.ByteString -> (Global, BSL.ByteString)
+parseGlobal content = do
+    let globalType = getTypeFromByte (head $ BSL.unpack content)
+    let mutability = parseMutability (head $ BSL.unpack $ BSL.drop 1 content)
+    let (expression, rest) = extractExpression (BSL.drop 2 content)
+    let instructions = parseInstructions expression
+    (Global globalType mutability instructions, rest)
+
+parseGlobals :: Int64 -> Int64 -> BSL.ByteString -> [Global]
+parseGlobals idx maxIdx content
+  | idx >= maxIdx = []
+  | otherwise = do
+    let (global, rest) = parseGlobal content
+    global : parseGlobals (idx + 1) maxIdx rest
+
+getGlobals :: Section -> [Global]
+getGlobals (Section GlobalID _ content) = do
+  let (vecSize, rest) = extractLEB128 content
+  parseGlobals 0 vecSize rest
+getGlobals _ = throw $ WasmError "getGlobals: bad section"

lvtrun/app/Parsing/Header.hs

@@ -0,0 +1,25 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Header
+-}
+
+module Parsing.Header
+  (
+    getModHeader,
+    isHeaderValid
+  )
+where
+
+import qualified Data.ByteString.Lazy as BSL (ByteString, take, drop, pack)
+
+import Types
+
+getModHeader :: Section -> ModHeader
+getModHeader bytes = ModHeader (BSL.take 4 $ content bytes) (BSL.take 4 $ BSL.drop 4 $ content bytes)
+
+isHeaderValid :: ModHeader -> Bool
+isHeaderValid header =
+  magicNumber header == BSL.pack [0x00, 0x61, 0x73, 0x6d] &&
+    version header == BSL.pack [0x01, 0x00, 0x00, 0x00]

lvtrun/app/Parsing/Memory.hs

@@ -0,0 +1,48 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Memory
+-}
+
+module Parsing.Memory
+  (
+    getMemories
+  ) where
+
+import qualified Data.ByteString.Lazy as BS
+import Control.Exception (throw)
+import Control.Monad (when)
+
+import Leb128
+import Types
+import Errors
+
+parseMinMax :: BS.ByteString -> Memory
+parseMinMax content
+  | endBs /= BS.empty = throw $ WasmError "parseMinMax: bad memory section"
+  | otherwise = Limit {lMin = fromIntegral min, lMax = Just (fromIntegral max)}
+  where
+    (min, rest) = extractLEB128 content
+    (max, endBs) = extractLEB128 rest
+
+parseMin :: BS.ByteString -> Memory
+parseMin content
+  | endBs /= BS.empty = throw $ WasmError "parseMin: bad memory section"
+  | otherwise = Limit {lMin = fromIntegral min, lMax = Nothing}
+  where
+    (min, endBs) = extractLEB128 content
+
+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)
+  | otherwise = throw $ WasmError "parseMemory: bad memory section"
+
+getMemories :: Section -> Memory
+getMemories (Section MemoryID _ content)
+  | head (BS.unpack content) == 0x01 = parseMemory (BS.drop 1 content)
+  | otherwise = throw $ WasmError "getMemories: v1 allow 1 memory only"
+getMemories _ = throw $ WasmError "getMemories: bad memory section"
+
+--https://webassembly.github.io/spec/core/exec/runtime.html#memory-instances