diff --git a/.github/workflows/documentation.yml b/.github/workflows/documentation.yml index 017b93a..278597a 100644 --- a/.github/workflows/documentation.yml +++ b/.github/workflows/documentation.yml @@ -48,6 +48,10 @@ jobs: if: steps.filter.outputs.docs == 'true' || steps.filter.outputs.docs2 == 'true' || steps.filter.outputs.workflow == 'true' || github.ref == 'refs/heads/main' run: mdbook build + - name: Copy OnlineRunner + if: steps.filter.outputs.docs == 'true' || steps.filter.outputs.docs2 == 'true' || steps.filter.outputs.workflow == 'true' || github.ref == 'refs/heads/main' + run: cp ./lvtext/webrunner/index.html ./book/OnlineVM.html + - name: Setup Pages if: github.ref == 'refs/heads/main' uses: actions/configure-pages@v3 diff --git a/Makefile b/Makefile index ee3e8f1..24566f5 100644 --- a/Makefile +++ b/Makefile @@ -14,6 +14,10 @@ $(TARGET): "$(MAKE)" -C "$(LVT_COMPILER)" "$(MAKE)" -C "$(LVT_RUNER)" +debug: + "$(MAKE)" -C "$(LVT_COMPILER)" debug + "$(MAKE)" -C "$(LVT_RUNER)" debug + clean: "$(MAKE)" -C "$(LVT_COMPILER)" clean "$(MAKE)" -C "$(LVT_RUNER)" clean diff --git a/README.md b/README.md index eb10a6f..d7bd166 100644 --- a/README.md +++ b/README.md @@ -13,11 +13,17 @@ // This is a comment ``` +- **Alias** + +``` +alias A = Int; +``` + - **Variables Declaration** ```hs @Int a = 1; -@String b = "hello"; +@StringView b = "hello"; ``` - **Variables Assignment** @@ -79,21 +85,6 @@ fn add(a: Int, b: Int, c: Int) -> Int }; ``` -- **Generic Functions** - -```rust -fn add[A](a: A, b: A) -> A -{ - <- a + b; -}; -``` - -- **Generic Functions Call** - -```rust -add[Int](1, 2); -``` - - **Conditions** ```c @@ -123,18 +114,11 @@ while (i < 10) }; ``` -- **Imports** - -```c -// Circular imports are not allowed -import "path/to/file.lvt" -``` - - **Entrypoint** ```rust // If you don't have this function, the program will not be run -fn start() -> Int +export fn start() -> Int { <- 0; }; @@ -142,51 +126,22 @@ fn start() -> Int - **Operators** -``` +```python a + b a - b a * b a / b a == b a != b +a < b +a <= b +a > b +a >= b ``` -- **Structs** +- **Priority of Operators** ```c -struct Point -{ - x: Int, - y: Int, -}; -``` - -- **Structs Initialization** -``` -@Point p = {1, 2}; -``` - -- **Structs Access** -``` -p:x -``` - -- **Nested Structs** -``` -struct Rect -{ - Point size; - Point pos; -}; -@Rect r = {{1, 2}, {3, 4}}; -r:size:x -``` - -- **Generic Structs** - -```c -struct Rect[A] -{ - attribute: A, -}; +// realy peticuliar buut we use { for ( and } for ) +{a + B} * c ``` diff --git a/docs/BNF.md b/docs/BNF.md new file mode 100644 index 0000000..1434673 --- /dev/null +++ b/docs/BNF.md @@ -0,0 +1,61 @@ +# Leviator BNF + +```bnf + ::= * + + ::= | | + + ::= "alias " " " ";\n" + ::= "A" | "B" | "C" | "D" | "E" | "F" | "G" | "H" | "I" | + "J" | "K" | "L" | "M" | "N" | "O" | "P" | "Q" | "R" | + "S" | "T" | "U" | "V" | "W" | "X" | "Y" | "Z" | "a" | + "b" | "c" | "d" | "e" | "f" | "g" | "h" | "i" | "j" | + "k" | "l" | "m" | "n" | "o" | "p" | "q" | "r" | "s" | + "t" | "u" | "v" | "w" | "x" | "y" | "z" | "0" | "1" | + "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" | "_" | + "." | "-" | ":" | "!" | "@" | "#" | "$" | "%" | "^" | + "&" | "*" | "(" | ")" | "[" | "]" | "{" | "}" | "|" | + "\\" | "+" | "=" | ";" | "<" | ">" | "?" | "/" | "`" | + "~" + ::= + + ::= "//" * "\n" + + ::= "fn " "(" * ") -> " "\n{\n" * "}\n" + ::= + ::= "," + ::= ": " + ::= + ::= ";\n" + ::= | | | | + ::= "@" " " " = " + ::= " = " + ::= "(" * ")" + ::= "," + ::= "<- " + ::= | | + ::= | | | + ::= | + ::= + ::= "if (" ")\n{\n" * "}\n" + ::= "else\n{\n" * "}\n" + + ::= "'" "'" + ::= "True" | "False" + ::= "\"" * "\"" + + ::= | | + ::= | "" | " " | + ::= | | | + ::= "a" | "b" | "c" | "d" | "e" | "f" | "g" | "h" | "i" | + "j" | "k" | "l" | "m" | "n" | "o" | "p" | "q" | "r" | + "s" | "t" | "u" | "v" | "w" | "x" | "y" | "z" + ::= "A" | "B" | "C" | "D" | "E" | "F" | "G" | "H" | "I" | + "J" | "K" | "L" | "M" | "N" | "O" | "P" | "Q" | "R" | + "S" | "T" | "U" | "V" | "W" | "X" | "Y" | "Z" + ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" + ::= "_" + ::= | "!" | "@" | "#" | "$" | "%" | "^" | "&" | + "*" | "(" | ")" | "[" | "]" | "{" | "}" | "|" | "\\" | + "+" | "=" | ";" | "<" | ">" | "?" | "/" | "`" | "~" +``` diff --git a/docs/OnlineVM.md b/docs/OnlineVM.md new file mode 100644 index 0000000..e69de29 diff --git a/docs/SUMMARY.md b/docs/SUMMARY.md index d10ee06..5da47ff 100644 --- a/docs/SUMMARY.md +++ b/docs/SUMMARY.md @@ -6,3 +6,6 @@ made in Haskell. [README](README.md) [Byte Code Spec](ByteCodeSpec.md) [Byte Code Spec Ex](ByteCodeSpecEx.md) +[Syntax Highlighting Extension](SyntaxHighlighting.md) +[BNF](BNF.md) +[Online VM](OnlineVM.md) diff --git a/docs/SyntaxHighlighting.md b/docs/SyntaxHighlighting.md new file mode 100644 index 0000000..547b400 --- /dev/null +++ b/docs/SyntaxHighlighting.md @@ -0,0 +1,10 @@ +## Leviator Lang Extension for Visual Studio Code + +We are thrilled to introduce our Leviator lang extension, providing enhanced syntax highlighting for an optimized coding experience. While currently available exclusively for vscode, we have ambitious plans to extend support to JetBrains and Vim in the future. + +### Installation + +To install the Leviator Language extension for **Visual Studio Code**, follow the steps below: + +1. Navigate to the "lvtext" directory in our [Leviator GitHub repository](https://github.com/X-R-G-B/Leviator/lvtext). +2. Refer to the detailed installation instructions provided in the [README.md](https://github.com/X-R-G-B/Leviator/blob/lvtext/vscode/leviator-lang/README.md) file. diff --git a/lvtc/Makefile b/lvtc/Makefile index 3df21cd..45fe629 100644 --- a/lvtc/Makefile +++ b/lvtc/Makefile @@ -21,6 +21,9 @@ all: $(TARGET) $(TARGET): stack build --copy-bins --local-bin-path . +debug: + stack build --trace --copy-bins --local-bin-path . + clean: stack clean diff --git a/lvtc/app/Args.hs b/lvtc/app/Args.hs new file mode 100644 index 0000000..5d40246 --- /dev/null +++ b/lvtc/app/Args.hs @@ -0,0 +1,85 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Args +-} + + +module Args + ( + Action(..), + Args(..), + parseArgs, + printHelp + ) where + +import System.Directory (getCurrentDirectory) + +data Action = ShowHelp | ShowVersion | Run + +data Args = Args { + action :: Action, + folderPath :: String, + outFile :: String, + verbose :: Bool +} + +parseArgs' :: [String] -> Args -> Either Args String +parseArgs' [] args = + Left args +parseArgs' ("--help":xs) args = + parseArgs' xs (args {action = ShowHelp}) +parseArgs' ("-h":xs) args = + parseArgs' xs (args {action = ShowHelp}) +parseArgs' ("--version":xs) args = + parseArgs' xs (args {action = ShowVersion}) +parseArgs' ("-v":xs) args = + parseArgs' xs (args {action = ShowVersion}) +parseArgs' ("-o":x:xs) args = + parseArgs' xs (args {outFile = x}) +parseArgs' ["-o"] _ = + Right "Missing argument for -o" +parseArgs' ("--verbose":xs) args = + parseArgs' xs (args {verbose = True}) +parseArgs' (('-':xs):_) _ = + Right ("Unknown option: " ++ xs) +parseArgs' (x:xs) args = + parseArgs' xs (args {action = Run, folderPath = x}) + +parseArgs :: [String] -> IO (Either Args String) +parseArgs args = + getCurrentDirectory >>= \path -> + return (parseArgs' args (Args { + action = Run, folderPath = path, outFile = "out.wasm", verbose = False + })) + +hLine1 :: String +hLine1 = "Usage: lvtc [OPTION] [FOLDER]\n" +hLine2 :: String +hLine2 = "\n" +hLine3 :: String +hLine3 = "Compile Leviator source code to WebAssembly\n" +hLine4 :: String +hLine4 = "" +hLine5 :: String +hLine5 = "Options:\n" +hLine6 :: String +hLine6 = "\t-h, --help\n\t\tDisplay this help and exit\n" +hLine7 :: String +hLine7 = "\t-v, --version\n\t\tOutput version information and exit\n" +hLine8 :: String +hLine8 = "\t-o FILE\n\t\tWrite WebAssembly to FILE\n" +hLine9 :: String +hLine9 = part1 ++ part2 + where + part1 = "\tFOLDER\n\t\tTake all Leviator" + part2 = " source code recursively from FOLDER\n" +hLine10 :: String +hLine10 = "\t--verbose\n\t\tVerbose mode\n" + +printHelp :: IO () +printHelp = + putStr hLine1 >> putStr hLine2 >> putStr hLine3 >> putStr hLine4 + >> putStr hLine5 >> putStr hLine6 >> putStr hLine7 >> putStr hLine8 + >> putStr hLine9 >> putStr hLine10 diff --git a/lvtc/app/Main.hs b/lvtc/app/Main.hs index 52b8bd5..cb24862 100644 --- a/lvtc/app/Main.hs +++ b/lvtc/app/Main.hs @@ -7,7 +7,20 @@ module Main (main) where -import Lib +import System.Environment (getArgs) + +import Args (Args (..), parseArgs, Action (..), printHelp) +import Run (run) +import Version (printVersion) + +dispatchArgs :: Args -> IO () +dispatchArgs (Args Run fPath oFile v) = run (Args Run fPath oFile v) +dispatchArgs (Args ShowHelp _ _ _) = printHelp +dispatchArgs (Args ShowVersion _ _ _) = printVersion + +dispatchIfOk :: Either Args String -> IO () +dispatchIfOk (Left args) = dispatchArgs args +dispatchIfOk (Right str) = print str main :: IO () -main = someFunc +main = getArgs >>= parseArgs >>= dispatchIfOk diff --git a/lvtc/app/Run.hs b/lvtc/app/Run.hs new file mode 100644 index 0000000..1a454fe --- /dev/null +++ b/lvtc/app/Run.hs @@ -0,0 +1,130 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Run +-} + +module Run +( + run +) where + +import Expression (parseAllExpression, Expression (..)) +import Alias (proceedAlias) +import ParseLvt (parseFuncDeclaration) +import WatLike (aSTToWatLike, FuncDeclare) +import Parser (runParser) +import AST (FuncDeclaration) +import WatAST (FuncDef) +import WatLikeToWat (watsLikeToWat) +import Wasm (Wasm) +import WatToWasm (watToWasm) +import WriteWasm (writeWasm) +import Args + +import System.Directory (listDirectory) +import System.FilePath (joinPath) +import Data.List (isSuffixOf) + +getExpressionFromFile :: FilePath -> IO [Expression] +getExpressionFromFile path = + readFile path + >>= (\str -> + case runParser (proceedAlias <$> parseAllExpression) str of + Nothing -> fail ("Invalid expression found in file: " ++ show path) + Just (expression, _) -> return expression) + +getFilesExpression :: Bool -> [FilePath] -> IO [Expression] +getFilesExpression v (file:files) = + p v + >> getExpressionFromFile file + >>= (\expFile -> getFilesExpression v files + >>= (\expFiles -> return (expFile ++ expFiles))) + where + p True = putStrLn ("Parsing expressions from: " ++ show file ++ "...") + p False = return () +getFilesExpression _ [] = return [] + +selectGoodFiles :: Bool -> FilePath -> [FilePath] -> IO [FilePath] +selectGoodFiles _ _ [] = return [] +selectGoodFiles v folder (file:files) + | ".lvt" `isSuffixOf` trueFile = + p v + >> selectGoodFiles v folder files + >>= (\others -> return (trueFile : others)) + | otherwise = selectGoodFiles v folder files + where + trueFile = joinPath [folder, file] + p True = putStrLn ("- " ++ show trueFile) + p False = return () + +listAllFiles :: Bool -> FilePath -> IO [FilePath] +listAllFiles v path = + p v + >> listDirectory path >>= selectGoodFiles v path + where + p True = putStrLn ("Compiling Folder: " ++ show path) + p False = return () + +getAllFunc :: Bool -> [Expression] -> IO [FuncDeclaration] +getAllFunc _ [] = return [] +getAllFunc v ((Expression.Function str):expressions) = + case runParser parseFuncDeclaration str of + Nothing -> fail ("Parser Error: " ++ show str) + Just (func, _) -> + getAllFunc v expressions >>= \funcs -> return (func:funcs) +getAllFunc v (x : expressions) = p v >> getAllFunc v expressions + where + p True = putStrLn ("Ignoring" ++ show x) + p False = return () + +-- TODO: replace with the function of gui +checkAst :: Bool -> IO [FuncDeclaration] -> IO [FuncDeclaration] +checkAst _ funcsIo = + funcsIo + >>= (\funcs -> case Just funcs of + Just f -> return f + Nothing -> fail "Invalid Code") + +transformToWatLike :: Bool -> IO [FuncDeclaration] -> IO [FuncDeclare] +transformToWatLike v funcsIo = + p v + >> funcsIo + >>= return . aSTToWatLike + where + p True = putStrLn "Transforming Leviator AST to IR (WatLike)..." + p False = return () + +transformToWat :: Bool -> IO [FuncDeclare] -> IO [FuncDef] +transformToWat v funcsIo = + p v + >> funcsIo + >>= return . watsLikeToWat + where + p True = putStrLn "Transforming IR (WatLike) to IR (Wat)..." + p False = return () + +transformToWasm :: Bool -> IO [FuncDef] -> IO Wasm +transformToWasm v funcsIo = + p v + >> funcsIo + >>= return . watToWasm + where + p True = putStrLn "Transforming IR (Wat) to Wasm..." + p False = return () + +showDebug :: Bool -> Wasm -> IO () +showDebug True wasm = print wasm +showDebug False _ = return () + +run :: Args -> IO () +run (Args Run fPath oFile v) = + transformedWasm >>= \wasm -> (showDebug v wasm >> writeWasm wasm oFile) + where + expressions = listAllFiles v fPath >>= getFilesExpression v + funcs = expressions >>= getAllFunc v + transformedWatLike = transformToWatLike v (checkAst v funcs) + transformedWat = transformToWat v transformedWatLike + transformedWasm = transformToWasm v transformedWat +run _ = fail "Invalid option called" diff --git a/lvtc/app/Version.hs b/lvtc/app/Version.hs new file mode 100644 index 0000000..7845ee0 --- /dev/null +++ b/lvtc/app/Version.hs @@ -0,0 +1,16 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Run +-} + +module Version +( + printVersion +) where + +import LvtLibVersion + +printVersion :: IO () +printVersion = putStrLn lvtLibVersion diff --git a/lvtc/lvtc.cabal b/lvtc/lvtc.cabal index b102c44..275f994 100644 --- a/lvtc/lvtc.cabal +++ b/lvtc/lvtc.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -25,7 +25,25 @@ source-repository head library exposed-modules: + Alias + AST + Builtins + Expression + Leb128Encode + Lexeme Lib + LvtLibVersion + ParseLvt + Parser + ParseUtil + ShuntingYard + Wasm + WasmUtils + WatAST + WatLike + WatLikeToWat + WatToWasm + WriteWasm other-modules: Paths_lvtc autogen-modules: @@ -35,11 +53,15 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , bytestring default-language: Haskell2010 executable lvtc-exe main-is: Main.hs other-modules: + Args + Run + Version Paths_lvtc autogen-modules: Paths_lvtc @@ -48,6 +70,8 @@ executable lvtc-exe ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , directory + , filepath , lvtc default-language: Haskell2010 @@ -55,6 +79,12 @@ test-suite lvtc-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + UTLexeme + UTParseLvt + UTShuntingYard + UTWasm + UTWat + UTWatLike Paths_lvtc autogen-modules: Paths_lvtc @@ -64,4 +94,7 @@ test-suite lvtc-test build-depends: base >=4.7 && <5 , lvtc + , process + , tasty + , tasty-hunit default-language: Haskell2010 diff --git a/lvtc/package.yaml b/lvtc/package.yaml index d6fb3e5..9459b79 100644 --- a/lvtc/package.yaml +++ b/lvtc/package.yaml @@ -35,6 +35,8 @@ ghc-options: library: source-dirs: src + dependencies: + - bytestring executables: lvtc-exe: @@ -46,6 +48,8 @@ executables: - -with-rtsopts=-N dependencies: - lvtc + - directory + - filepath tests: lvtc-test: @@ -57,3 +61,6 @@ tests: - -with-rtsopts=-N dependencies: - lvtc + - tasty + - tasty-hunit + - process diff --git a/lvtc/src/AST.hs b/lvtc/src/AST.hs new file mode 100644 index 0000000..16a6e80 --- /dev/null +++ b/lvtc/src/AST.hs @@ -0,0 +1,105 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- AST +-} + +module AST + ( Type + , Value (..) + , Var + , FuncCall + , FuncPrototype + , FuncDeclaration + , Instruction (..) + , VarDeclaration + , VarAssignation + , Condition + , Symbol + , IsFuncExport + ) where + +import Data.Int (Int32) + +type Symbol = String + +type Type = String + +data Value = + Var String + | FuncValue FuncCall + | Boolean Bool + | Integer Int32 + | Character Char + | StringView String + | Void + +instance Show Value where + show (Var x) = "V< " ++ show x ++ " >" + show (FuncValue x) = "F< " ++ show x ++ " >" + show (Boolean x) = "B< " ++ show x ++ " >" + show (Integer x) = "I< " ++ show x ++ " >" + show (Character x) = "C< " ++ show x ++ " >" + show (StringView x) = "SV< " ++ show x ++ " >" + show Void = "Void" + +instance Eq Value where + (==) (Var x) (Var y) = x == y + (==) (FuncValue x) (FuncValue y) = x == y + (==) (Boolean x) (Boolean y) = x == y + (==) (Integer x) (Integer y) = x == y + (==) (Character x) (Character y) = x == y + (==) (StringView x) (StringView y) = x == y + (==) Void Void = True + (==) _ _ = False + +-- Function + +type Var = (Symbol, Type) + +type IsFuncExport = Bool + +type FuncPrototype = (IsFuncExport, Symbol, [Var], Type) + +type FuncDeclaration = (FuncPrototype, [Instruction]) + + +-- condition + +type Condition = (Value, [Instruction], [Instruction]) + +-- Instruction + +type FuncCall = (Symbol, [Value]) + +type VarDeclaration = (Var, Value) + +type VarAssignation = (Symbol, Value) + +data Instruction = + Function FuncCall + | Return Value + | Declaration VarDeclaration + | Assignation VarAssignation + | Cond Condition + +instance Show Instruction where + show (Function x) = + "Function[< " ++ show x ++ " >]" + show (Return x) = + "Return[< " ++ show x ++ " >]" + show (Declaration x) = + "Declaration[< " ++ show x ++ " >]" + show (Assignation x) = + "Assignation[< " ++ show x ++ " >]" + show (Cond x) = + "Cond[< " ++ show x ++ " >]" + +instance Eq Instruction where + (==) (Function x) (Function y) = x == y + (==) (Return x) (Return y) = x == y + (==) (Declaration x) (Declaration y) = x == y + (==) (Assignation x) (Assignation y) = x == y + (==) (Cond x) (Cond y) = x == y + (==) _ _ = False diff --git a/lvtc/src/Alias.hs b/lvtc/src/Alias.hs new file mode 100644 index 0000000..fafd5f2 --- /dev/null +++ b/lvtc/src/Alias.hs @@ -0,0 +1,80 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Alias +-} + +module Alias ( + proceedAlias, +) where + +import Expression +import Parser +import ParseUtil +import Control.Applicative + +data Alias = Alias String String + +instance Show Alias.Alias where + show (Alias.Alias str1 str2) = "ALIAS `" ++ str1 ++ "`:`" ++ str2 ++ "`" + +parseAliasKeyword :: Parser String +parseAliasKeyword = parseString "alias " + +parseAliasName :: Parser String +parseAliasName = parseAllCharUntil " " + +parseAliasValue :: Parser String +parseAliasValue = parseAllCharUntil ";\n" + +parseAlias' :: Parser String +parseAlias' = (parseAliasKeyword *> parseAliasName <* many (parseChar ' ')) + +parseAlias :: Parser Alias.Alias +parseAlias = Parser f + where + f str = case runParser parseAlias' str of + Nothing -> Nothing + Just (key, xs) -> case runParser parseAliasValue xs of + Nothing -> Nothing + Just (value, ys) -> Just (Alias.Alias key value, ys) + +replaceAliasInString :: Alias.Alias -> String -> String +replaceAliasInString _ [] = [] +replaceAliasInString (Alias.Alias key value) (x:xs) + | take (length key) (x:xs) == key = + value ++ replaceAliasInString + (Alias.Alias key value) + (drop (length key) (x:xs)) + | otherwise = x : replaceAliasInString (Alias.Alias key value) xs + +replaceAlias :: Alias -> [Expression] -> [Expression] +replaceAlias _ [] = [] +replaceAlias alias ((Expression.Alias _):xs) = + replaceAlias alias xs +replaceAlias (Alias.Alias key value) ((Expression.Function str):xs) = + (Expression.Function (replaceAliasInString (Alias.Alias key value) str)) + : (replaceAlias (Alias.Alias key value) xs) +replaceAlias (Alias.Alias key value) ((Expression.Comment str):xs) = + (Expression.Comment (replaceAliasInString (Alias.Alias key value) str)) + : (replaceAlias (Alias.Alias key value) xs) + +replaceAllAlias :: [Alias] -> [Expression] -> [Expression] +replaceAllAlias [] exprs = exprs +replaceAllAlias _ [] = [] +replaceAllAlias (x:xs) exprs = replaceAllAlias xs newExprs + where + newExprs = replaceAlias x exprs + +getListAlias :: [Expression] -> [Alias] +getListAlias [] = [] +getListAlias ((Expression.Alias str):xs) = case runParser parseAlias str of + Just (alias, _) -> alias : getListAlias xs + Nothing -> getListAlias xs +getListAlias (_:xs) = getListAlias xs + +proceedAlias :: [Expression] -> [Expression] +proceedAlias exprs = replaceAllAlias lstAlias exprs + where + lstAlias = getListAlias exprs diff --git a/lvtc/src/Builtins.hs b/lvtc/src/Builtins.hs new file mode 100644 index 0000000..36b5b82 --- /dev/null +++ b/lvtc/src/Builtins.hs @@ -0,0 +1,83 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Builtins +-} + +module Builtins +( + getBuiltinsFunc + , isBuiltinsFunc + , getBuiltinsWat + , getBuiltinWat +) where + +import Text.Read (readMaybe) + +import AST +import WatAST + +getBuiltinsFuncOperator :: [FuncDeclaration] +getBuiltinsFuncOperator = + [ + ((False, "+", [("x", "Int"), ("y", "Int")], "Int"), []), + ((False, "-", [("x", "Int"), ("y", "Int")], "Int"), []), + ((False, "*", [("x", "Int"), ("y", "Int")], "Int"), []), + ((False, "/", [("x", "Int"), ("y", "Int")], "Int"), []) + ] + +getBuiltinsFuncComp :: [FuncDeclaration] +getBuiltinsFuncComp = + [ + ((False, "==", [("x", "Int"), ("y", "Int")], "Bool"), []), + ((False, "<", [("x", "Int"), ("y", "Int")], "Bool"), []), + ((False, ">", [("x", "Int"), ("y", "Int")], "Bool"), []), + ((False, "<=", [("x", "Int"), ("y", "Int")], "Bool"), []), + ((False, ">=", [("x", "Int"), ("y", "Int")], "Bool"), []), + ((False, "!=", [("x", "Int"), ("y", "Int")], "Bool"), []) + ] + +getBuiltinsFunc :: [FuncDeclaration] +getBuiltinsFunc = getBuiltinsFuncOperator ++ getBuiltinsFuncComp + +getStackRet :: [OpCode] -> [OpCode] +getStackRet op = [LocalGet 0, LocalGet 1] ++ op ++ [WatAST.Return] + +getBuiltinsWatOperator :: [FuncDef] +getBuiltinsWatOperator = + [ + FuncDef False "+" 0 [I32, I32] I32 (getStackRet [I32Add]) [], + FuncDef False "-" 1 [I32, I32] I32 (getStackRet [I32Sub]) [], + FuncDef False "*" 2 [I32, I32] I32 (getStackRet [I32Mul]) [], + FuncDef False "/" 3 [I32, I32] I32 (getStackRet [I32Div]) [] + ] + +getBuiltinsWatComp :: [FuncDef] +getBuiltinsWatComp = [ + FuncDef False "==" 4 [I32, I32] I32 (getStackRet [I32EQ]) [], + FuncDef False "<" 5 [I32, I32] I32 (getStackRet [I32LT_S]) [], + FuncDef False ">" 6 [I32, I32] I32 (getStackRet [I32GT_S]) [], + FuncDef False "<=" 7 [I32, I32] I32 (getStackRet [I32LE_S]) [], + FuncDef False ">=" 8 [I32, I32] I32 (getStackRet [I32GE_S]) [], + FuncDef False "!=" 9 [I32, I32] I32 (getStackRet [I32NE]) [] + ] + +getBuiltinsWat :: [FuncDef] +getBuiltinsWat = getBuiltinsWatOperator ++ getBuiltinsWatComp + +isBuiltinsFuncString :: String -> [FuncDeclaration] -> Bool +isBuiltinsFuncString _ [] = False +isBuiltinsFuncString name (((_, name', _, _), _):xs) + | name == name' = True + | otherwise = isBuiltinsFuncString name xs + +isBuiltinsFunc :: String -> Bool +isBuiltinsFunc indexName = case readMaybe indexName :: Maybe Int of + Nothing -> isBuiltinsFuncString indexName getBuiltinsFunc + Just x -> x < (length getBuiltinsFunc) + +getBuiltinWat :: String -> FuncDef +getBuiltinWat indexName = case readMaybe indexName :: Maybe Int of + Nothing -> error "builtins not found" + Just x -> getBuiltinsWat !! x diff --git a/lvtc/src/Expression.hs b/lvtc/src/Expression.hs new file mode 100644 index 0000000..b10e111 --- /dev/null +++ b/lvtc/src/Expression.hs @@ -0,0 +1,84 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Expression +-} + +module Expression ( + Expression (..), + parseExpresion, + parseAllExpression, +) where + +import Parser +import Control.Applicative +import ParseUtil + +data Expression = Function String | Alias String | Comment String + +instance Show Expression where + show (Function str) = "F:`" ++ str ++ "`" + show (Alias str) = "A:`" ++ str ++ "`" + show (Comment str) = "C:`" ++ str ++ "`" + +instance Eq Expression where + (==) (Function str1) (Function str2) = str1 == str2 + (==) (Alias str1) (Alias str2) = str1 == str2 + (==) (Comment str1) (Comment str2) = str1 == str2 + (==) _ _ = False + +countBracketsForFunction :: Int -> String -> Int +countBracketsForFunction _ [] = 0 +countBracketsForFunction 1 ['\n', '}', ';', '\n'] = 0 +countBracketsForFunction n ['\n', '}', ';', '\n'] = n +countBracketsForFunction 1 ('}':_) = 1 +countBracketsForFunction n ('{':xs) = countBracketsForFunction (n + 1) xs +countBracketsForFunction n ('}':xs) = countBracketsForFunction (n - 1) xs +countBracketsForFunction n ('\\':_:xs) = countBracketsForFunction n xs +countBracketsForFunction n (_:xs) = countBracketsForFunction n xs + +parseFunction' :: Parser Expression +parseFunction' = + (\x -> Function (x ++ "\n};\n")) + <$> ((++) + <$> (parseString "fn " <|> parseString "export fn") + <*> parseAllCharUntil "\n};\n") + +parseFunction :: Parser Expression +parseFunction = Parser f + where + f str = case runParser parseFunction' str of + Nothing -> Nothing + Just (Function x, xs) -> case countBracketsForFunction 0 x of + 0 -> Just (Function x, xs) + _ -> Nothing + Just _ -> Nothing + +parseAlias :: Parser Expression +parseAlias = + (\x -> Alias (x ++ ";\n")) + <$> ((++) + <$> parseString "alias " + <*> parseAllCharUntil ";\n") + +parseComment :: Parser Expression +parseComment = + (\x -> Comment (x ++ "\n")) + <$> ((++) + <$> parseString "//" + <*> parseAllCharUntil "\n") + +parseExpresion :: Parser Expression +parseExpresion = parseAlias <|> parseFunction <|> parseComment + +parseAllExpression :: Parser [Expression] +parseAllExpression = Parser f + where + p = parseExpresion <* many (parseAnyChar "\n") + f [] = Just ([], []) + f str = case runParser p str of + Nothing -> Nothing + Just (x, xs) -> case runParser parseAllExpression xs of + Nothing -> Nothing + Just (y, ys) -> Just (x : y, ys) diff --git a/lvtc/src/Leb128Encode.hs b/lvtc/src/Leb128Encode.hs new file mode 100644 index 0000000..b30185b --- /dev/null +++ b/lvtc/src/Leb128Encode.hs @@ -0,0 +1,18 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Leb128Encode +-} + +module Leb128Encode +( + leb128Encode +) where + +import Data.Bits + +leb128Encode :: Int -> [Int] +leb128Encode n + | n < 0x80 = [n] + | otherwise = ((n .&. 0x7F) .|. 0x80) : leb128Encode (n `shiftR` 7) diff --git a/lvtc/src/Lexeme.hs b/lvtc/src/Lexeme.hs new file mode 100644 index 0000000..f102d87 --- /dev/null +++ b/lvtc/src/Lexeme.hs @@ -0,0 +1,80 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ParseLvt +-} + +module Lexeme +( + lexeme1 +) where + +replaceN :: Int -> String -> String +replaceN _ [] = [] +replaceN 0 ('"':xs) = '"' : replaceN 1 xs +replaceN 1 ('\\':'n':xs) = '\n' : replaceN 1 xs +replaceN 1 ('\\':'t':xs) = '\t' : replaceN 1 xs +replaceN 1 ('\\':'v':xs) = '\v' : replaceN 1 xs +replaceN 1 ('\\':'a':xs) = '\a' : replaceN 1 xs +replaceN 1 ('\\':'f':xs) = '\f' : replaceN 1 xs +replaceN 1 ('\\':'r':xs) = '\r' : replaceN 1 xs +replaceN 1 ('\\':x:xs) = '\\':x : replaceN 1 xs +replaceN 1 ('"':xs) = '"' : replaceN 0 xs +replaceN 0 ('\n':xs) = ' ' : replaceN 0 xs +replaceN n (x:xs) = x : replaceN n xs + +lexeme :: Int -> String -> String +lexeme _ [] = [] +lexeme 0 (' ':')':xs) = lexeme 0 (')':xs) +lexeme 0 (' ':'(':xs) = lexeme 0 ('(':xs) +lexeme 0 (' ':'}':xs) = lexeme 0 ('}':xs) +lexeme 0 (' ':'{':xs) = lexeme 0 ('{':xs) +lexeme 0 (' ':']':xs) = lexeme 0 (']':xs) +lexeme 0 (' ':'[':xs) = lexeme 0 ('[':xs) +lexeme 0 (' ':'+':xs) = lexeme 0 ('+':xs) +lexeme 0 (' ':'-':xs) = lexeme 0 ('-':xs) +lexeme 0 (' ':'*':xs) = lexeme 0 ('*':xs) +lexeme 0 (' ':'/':xs) = lexeme 0 ('/':xs) +lexeme 0 (' ':'<':xs) = lexeme 0 ('<':xs) +lexeme 0 (' ':'>':xs) = lexeme 0 ('>':xs) +lexeme 0 (' ':'=':xs) = lexeme 0 ('=':xs) +lexeme 0 (' ':'!':xs) = lexeme 0 ('!':xs) +lexeme 0 (' ':':':xs) = lexeme 0 (':':xs) +lexeme 0 (' ':',':xs) = lexeme 0 (',':xs) +lexeme 0 (' ':'@':xs) = lexeme 0 ('@':xs) +lexeme 0 (' ':';':xs) = lexeme 0 (';':xs) +lexeme 0 ('(':' ':xs) = lexeme 0 ('(':xs) +lexeme 0 (')':' ':xs) = lexeme 0 (')':xs) +lexeme 0 ('}':' ':xs) = lexeme 0 ('}':xs) +lexeme 0 ('{':' ':xs) = lexeme 0 ('{':xs) +lexeme 0 (']':' ':xs) = lexeme 0 (']':xs) +lexeme 0 ('[':' ':xs) = lexeme 0 ('[':xs) +lexeme 0 ('+':' ':xs) = lexeme 0 ('+':xs) +lexeme 0 ('-':' ':xs) = lexeme 0 ('-':xs) +lexeme 0 ('*':' ':xs) = lexeme 0 ('*':xs) +lexeme 0 ('/':' ':xs) = lexeme 0 ('/':xs) +lexeme 0 ('<':' ':xs) = lexeme 0 ('<':xs) +lexeme 0 ('>':' ':xs) = lexeme 0 ('>':xs) +lexeme 0 ('=':' ':xs) = lexeme 0 ('=':xs) +lexeme 0 ('!':' ':xs) = lexeme 0 ('!':xs) +lexeme 0 (':':' ':xs) = lexeme 0 (':':xs) +lexeme 0 (',':' ':xs) = lexeme 0 (',':xs) +lexeme 0 ('@':' ':xs) = lexeme 0 ('@':xs) +lexeme 0 (';':' ':xs) = lexeme 0 (';':xs) +lexeme 0 ('i':'f':' ':xs) = lexeme 0 ('i':'f':xs) +lexeme 0 (' ':'i':'f':xs) = lexeme 0 ('i':'f':xs) +lexeme 0 ('e':'l':'s':'e':' ':xs) = lexeme 0 ('e':'l':'s':'e':xs) +lexeme 0 (' ':'e':'l':'s':'e':xs) = lexeme 0 ('e':'l':'s':'e':xs) +lexeme 0 ('\\':x:xs) = x : lexeme 0 xs +lexeme 1 ('\\':x:xs) = x : lexeme 1 xs +lexeme 0 (' ':' ':xs) = lexeme 0 (' ':xs) +lexeme 1 ('"':xs) = '"' : lexeme 0 xs +lexeme 0 ('"':xs) = '"' : lexeme 1 xs +lexeme n (x:xs) = x : lexeme n xs + +stripLastSpaces :: String -> String +stripLastSpaces = reverse . dropWhile (== ' ') . reverse + +lexeme1 :: String -> String +lexeme1 str = stripLastSpaces $ lexeme 0 (replaceN 0 str) diff --git a/lvtc/src/LvtLibVersion.hs b/lvtc/src/LvtLibVersion.hs new file mode 100644 index 0000000..4cc4899 --- /dev/null +++ b/lvtc/src/LvtLibVersion.hs @@ -0,0 +1,33 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- LvtLibVersion +-} + +module LvtLibVersion + ( + lvtLibVersionPatch, + lvtLibVersionMinor, + lvtLibVersionMajor, + lvtLibVersion + ) + where + +lvtLibVersionPatch :: Int +lvtLibVersionPatch = 0 + +lvtLibVersionMinor :: Int +lvtLibVersionMinor = 0 + +lvtLibVersionMajor :: Int +lvtLibVersionMajor = 0 + + +lvtLibVersion :: String +lvtLibVersion = fullVersion + where + fMaj = show lvtLibVersionMajor + fMin = show lvtLibVersionMinor + fPat = show lvtLibVersionPatch + fullVersion = fMaj ++ "." ++ fMin ++ "." ++ fPat diff --git a/lvtc/src/ParseLvt.hs b/lvtc/src/ParseLvt.hs new file mode 100644 index 0000000..c93fa17 --- /dev/null +++ b/lvtc/src/ParseLvt.hs @@ -0,0 +1,329 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ParseLvt +-} + +module ParseLvt +( + -- Value + parseValue, + parseVar, + parseFuncValue, + parseBoolean, + parseInteger, + parseCharacter, + parseStringView, + parseVoid, + -- Instruction + parseInstructions, + parseInstruction, + parseFunction, + parseReturn, + parseDeclaration, + parseAssignation, + parseCond, + -- Function + parseFuncDeclaration +) where + +import Control.Applicative + +import AST + +import Parser +import ParseUtil +import ShuntingYard +import Lexeme + +parseBoolean :: Parser Value +parseBoolean = + ((\_ -> Boolean True) <$> parseString "True") + <|> ((\_ -> Boolean False) <$> parseString "False") + +parseInteger :: Parser Value +parseInteger = Integer <$> parseInt + +parseFuncValue :: Parser Value +parseFuncValue = Parser f + where + f str = case runParser parseCall str of + Nothing -> Nothing + Just (Function x, xs) -> Just (FuncValue x, xs) + _notAFunction -> Nothing + +parseCharacter :: Parser Value +parseCharacter = + Character <$> + ( + parseChar '\'' + *> parseAnyChar (alphabet ++ digit ++ special) + <* parseChar '\'' + ) + +parseStringView :: Parser Value +parseStringView = + StringView <$> + ( + parseChar '\"' + *> parseAllCharUntil "\"" + ) + +parseVarName :: Parser Symbol +parseVarName = + f + <$> parseAnyChar alphabetLower + <*> many (parseAnyChar (alphabet ++ digit ++ "_")) + where + f fstChar restName = fstChar : restName + +parseVar :: Parser Value +parseVar = Var <$> parseVarName + +parseVoid :: Parser Value +parseVoid = f <$> parseString "Void" + where + f _ = Void + +parseOperatorFstVal :: Parser Value +parseOperatorFstVal = parseValueWithoutOperator + +parseOperatorOp :: Parser Value +parseOperatorOp = + Var + <$> (parseString "+" <|> parseString "-" <|> parseString "*" + <|> parseString "/" <|> parseString "{" <|> parseString "}" + <|> parseString "==" <|> parseString "!=" <|> parseString "<" + <|> parseString ">" <|> parseString "<=" <|> parseString ">=") + +parseOperator' :: ShuntingYardState -> Parser ShuntingYardState +parseOperator' sys = + (fOp <$> parseOperatorOp) + <|> (fVal <$> parseOperatorFstVal) + where + fVal val = shuntingYardValue val sys + fOp op = shuntingYardOp op sys + +parseOperatorTransformOne' :: [Value] -> Maybe [Value] +parseOperatorTransformOne' (x1:x2:(Var op):rest) + | isOperator op = Just (FuncValue (op, [x1, x2]) : rest) + | otherwise = (\ys -> x1:x2:ys) <$> parseOperatorTransformOne rest +parseOperatorTransformOne' _ = Nothing + +parseOperatorTransformOne :: [Value] -> Maybe [Value] +parseOperatorTransformOne [] = Just [] +parseOperatorTransformOne [x] = Just [x] +parseOperatorTransformOne [_, _] = Nothing +parseOperatorTransformOne (x1:(Var op):rest) + | isOperator op = Nothing + | otherwise = parseOperatorTransformOne' (x1 : Var op : rest) +parseOperatorTransformOne (x1:x2:(Var op):rest) = + parseOperatorTransformOne' (x1 : x2 : Var op : rest) +parseOperatorTransformOne (x:xs) = (x :) <$> parseOperatorTransformOne xs + +parseOperatorTransform :: [Value] -> Maybe Value +parseOperatorTransform [] = Nothing +parseOperatorTransform vals = + case parseOperatorTransformOne vals of + Nothing -> Nothing + Just [] -> Nothing + Just [x] -> Just x + Just (x:rest) -> parseOperatorTransform (x:rest) + +parseOperatorS :: ShuntingYardState -> Parser ShuntingYardState +parseOperatorS sys = Parser f + where + f str = case runParser (parseOperator' sys) str of + Nothing -> Just (sys, str) + Just (x, xs) -> case runParser (parseOperatorS x) xs of + Nothing -> Just (x, xs) + Just (y, ys) -> Just (y, ys) + +parseOperator :: Parser Value +parseOperator = Parser f + where + f str = case runParser (parseOperatorS (SYS [] [])) str of + Nothing -> Nothing + Just (x, xs) -> pat (shuntingYardEnd x) xs + pat (SYS _ vals) str = case parseOperatorTransform vals of + Nothing -> Nothing + Just x -> Just (x, str) + +parseValue :: Parser Value +parseValue = + parseOperator + <|> parseValueWithoutOperator + +parseValueWithoutOperator :: Parser Value +parseValueWithoutOperator = + parseFuncValue + <|> parseBoolean + <|> parseVoid + <|> parseInteger + <|> parseStringView + <|> parseCharacter + <|> parseVar + +parseCallName :: Parser Symbol +parseCallName = + f + <$> parseAnyChar alphabetLower + <*> many (parseAnyChar (alphabet ++ digit ++ "_")) + <* parseChar '(' + where + f fstChar restName = fstChar : restName + +parseCallArg :: Parser Value +parseCallArg = Parser f + where + f str = case runParser parseValue str of + Nothing -> Nothing + Just (x, ',':' ':xs) -> Just (x, xs) + Just (x, ',':xs) -> Just (x, xs) + Just (x, xs) -> Just (x, xs) + +parseCallArgs :: Parser [Value] +parseCallArgs = Parser f + where + f (')':xs) = Just ([], xs) + f str = case runParser parseCallArg str of + Nothing -> Nothing + Just (x, xs) -> + case runParser parseCallArgs xs of + Nothing -> Just ([x], xs) + Just (y, ys) -> Just (x:y, ys) + +parseCall :: Parser Instruction +parseCall = f <$> parseCallName <*> parseCallArgs + where + f name args = Function (name, args) + +parseFunction :: Parser Instruction +parseFunction = parseCall + +parseReturn :: Parser Instruction +parseReturn = Return <$> (parseString "<-" *> parseValue) + +parseType :: Parser String +parseType = + parseString "Bool" + <|> parseString "Int" + <|> parseString "Char" + <|> parseString "Void" + <|> parseString "StringView" + +parseDeclaration' :: String -> Parser Instruction +parseDeclaration' typ = Parser f + where + f str = case runParser parseAssignation str of + Nothing -> Nothing + Just (Assignation (name, val), xs) -> + Just (Declaration ((name, typ), val), xs) + _notAssignation -> Nothing + +parseDeclaration :: Parser Instruction +parseDeclaration = Parser f + where + f str = case + runParser (parseChar '@' *> parseType <* parseChar ' ') str + of + Nothing -> Nothing + Just (typ, xs) -> runParser (parseDeclaration' typ) xs + +parseAssignation :: Parser Instruction +parseAssignation = Parser f + where + f str = case runParser (parseVar <* parseString "=") str of + Nothing -> Nothing + Just (Var x, xs) -> + case runParser parseValue xs of + Nothing -> Nothing + Just (y, ys) -> Just (Assignation (x, y), ys) + _notVar -> Nothing + +parseCondComp :: Parser Value +parseCondComp = parseString "if(" *> parseValue <* parseString ")" + +parseCondIf :: Parser [Instruction] +parseCondIf = parseString "{" *> parseInstructions <* parseString "}" + +parseCondElse :: Parser [Instruction] +parseCondElse = parseString "else{" *> parseInstructions <* parseString "}" + +parseCond' :: Value -> [Instruction] -> Parser Instruction +parseCond' val ifBlock = Parser f + where + f (';':str) = Just (Cond (val, ifBlock, []), ';':str) + f str = case runParser parseCondElse str of + Nothing -> Nothing + Just (elseBlock, ys) -> Just (Cond (val, ifBlock, elseBlock), ys) + +parseCond :: Parser Instruction +parseCond = Parser f + where + f str = case runParser parseCondComp str of + Nothing -> Nothing + Just (val, xs) -> + case runParser parseCondIf xs of + Nothing -> Nothing + Just (ifBlock, ys) -> runParser (parseCond' val ifBlock) ys + +parseInstruction :: Parser Instruction +parseInstruction = + (parseCond + <|> parseReturn + <|> parseDeclaration + <|> parseAssignation + <|> parseFunction + ) <* parseString ";" + +parseInstructions :: Parser [Instruction] +parseInstructions = some parseInstruction + +parseFuncVar :: Parser Var +parseFuncVar = Parser f + where + f str = case runParser (parseVar <* parseString ":") str of + Nothing -> Nothing + Just (Var x, xs) -> runParser (lmbda x <$> parseType) xs + _notVar -> Nothing + lmbda var typ = (var, typ) + +parseFuncVars :: Parser [Var] +parseFuncVars = + parseChar '(' *> + many + (parseFuncVar + <* (parseString "," <|> parseString " ," <|> parseString ", ") + <|> parseFuncVar) + <* parseChar ')' + +parseFuncName :: Parser (IsFuncExport, Symbol) +parseFuncName = + ((\x -> (True, x)) <$> (parseString "export fn " *> parseVarName)) + <|> ((\x -> (False, x)) <$> (parseString "fn " *> parseVarName)) + +parseFuncType :: Parser Type +parseFuncType = parseString "->" *> parseType <* parseString "{" + +parseFuncPrototype :: Parser FuncPrototype +parseFuncPrototype = + f + <$> parseFuncName + <*> parseFuncVars + <*> parseFuncType + where + f (isExport, name) vars funcType = (isExport, name, vars, funcType) + +parseFuncDeclaration' :: Parser FuncDeclaration +parseFuncDeclaration' = + (,) + <$> parseFuncPrototype + <*> parseInstructions + <* parseString "};" + +parseFuncDeclaration :: Parser FuncDeclaration +parseFuncDeclaration = Parser f + where + f str = runParser parseFuncDeclaration' (lexeme1 str) diff --git a/lvtc/src/ParseUtil.hs b/lvtc/src/ParseUtil.hs new file mode 100644 index 0000000..0649352 --- /dev/null +++ b/lvtc/src/ParseUtil.hs @@ -0,0 +1,97 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ParseUtil +-} + +module ParseUtil ( + parseChar, + parseAnyChar, + parseUInt, + parseSign, + parseInt, + parseString, + parseBetween, + parseAfter, + parseBefore, + parseAllCharUntil, + alphabet, + alphabetLower, + alphabetUpper, + digit, + special, +) where + +import Parser +import Data.Int (Int32) +import Control.Applicative + +alphabetLower :: String +alphabetLower = ['a'..'z'] + +alphabetUpper :: String +alphabetUpper = ['A'..'Z'] + +alphabet :: String +alphabet = alphabetLower ++ alphabetUpper + +digit :: String +digit = ['0'..'9'] + +special :: String +special = + [ + '_', ' ', '(', ')', '{', '}', ';', ',', ':', '.', + '+', '-', '*', '/', '%', '^', '!', '?' + ] + +parseChar :: Char -> Parser Char +parseChar c = Parser f + where + f [] = Nothing + f (x:xs) | x == c = Just (x, xs) + | otherwise = Nothing + +parseAnyChar :: String -> Parser Char +parseAnyChar str = Parser f + where + f [] = Nothing + f (x:xs) | x `elem` str = Just (x, xs) + | otherwise = Nothing + +parseString :: String -> Parser String +parseString value = Parser f + where + f s | take (length value) s == value = + Just (value, drop (length value) s) + | otherwise = Nothing + +parseUInt :: Parser Int32 +parseUInt = read <$> some (parseAnyChar "0123456789") + +parseSign :: Parser Int32 +parseSign = f <$> many (parseAnyChar "-+") + where + f s | even (length (filter (== '-') s)) = 1 + | otherwise = -1 + +parseInt :: Parser Int32 +parseInt = (*) <$> parseSign <*> parseUInt + +parseBetween :: Parser a -> Parser b -> Parser c -> Parser c +parseBetween open close parser = open *> parser <* close + +parseAfter :: Parser a -> Parser b -> Parser b +parseAfter open parser = open *> parser + +parseBefore :: Parser a -> Parser b -> Parser a +parseBefore parser close = parser <* close + +parseAllCharUntil :: String -> Parser String +parseAllCharUntil str = Parser f + where + f [] = empty + f (x:xs) = case runParser (parseString str) (x:xs) of + Nothing -> runParser ((x :) <$> parseAllCharUntil str) xs + Just (_, ys) -> Just ([], ys) diff --git a/lvtc/src/Parser.hs b/lvtc/src/Parser.hs new file mode 100644 index 0000000..5bf4bde --- /dev/null +++ b/lvtc/src/Parser.hs @@ -0,0 +1,54 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- Parser +-} + +module Parser ( + Parser (..), +) where + +import Control.Applicative + +data Parser a = Parser { + runParser :: String -> Maybe (a, String) +} + +instance Functor Parser where + fmap fct parser = Parser f + where + f str = case runParser parser str of + Just (x, xs) -> Just (fct x, xs) + Nothing -> Nothing + +instance Applicative Parser where + pure x = Parser f + where + f str = Just (x, str) + p1 <*> p2 = Parser f + where + f str = case runParser p1 str of + Just (x, xs) -> + case runParser p2 xs of + Just (y, ys) -> Just (x y, ys) + Nothing -> Nothing + Nothing -> Nothing + +instance Alternative Parser where + empty = Parser f + where + f _ = Nothing + p1 <|> p2 = Parser f + where + f str = case runParser p1 str of + Just (x, xs) -> Just (x, xs) + Nothing -> runParser p2 str + +instance Monad Parser where + parser >>= fct = Parser f + where + f str = case runParser parser str of + Just (x, xs) -> runParser (fct x) xs + Nothing -> Nothing + return = pure diff --git a/lvtc/src/ShuntingYard.hs b/lvtc/src/ShuntingYard.hs new file mode 100644 index 0000000..b3cfca9 --- /dev/null +++ b/lvtc/src/ShuntingYard.hs @@ -0,0 +1,82 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ShuntingYard +-} + +module ShuntingYard +( + shuntingYardOp, + shuntingYardEnd, + shuntingYardValue, + ShuntingYardState (..), + isOperator +) where + +import AST + +data ShuntingYardState = SYS [Value] [Value] + +instance Eq ShuntingYardState where + (==) (SYS y z) (SYS y' z') = y == y' && z == z' + +instance Show ShuntingYardState where + show (SYS y z) = "SYS[< " ++ show y ++ " >< " ++ show z ++ " >]" + +shuntingYardValue :: Value -> ShuntingYardState -> ShuntingYardState +shuntingYardValue val (SYS ops out) = SYS ops (out ++ [val]) + +isOperator :: String -> Bool +isOperator "!=" = True +isOperator "==" = True +isOperator "<" = True +isOperator ">" = True +isOperator "<=" = True +isOperator ">=" = True +isOperator "+" = True +isOperator "-" = True +isOperator "*" = True +isOperator "/" = True +isOperator _ = False + +getPrecedence :: String -> Int +getPrecedence "!=" = 1 +getPrecedence "==" = 1 +getPrecedence "<" = 1 +getPrecedence ">" = 1 +getPrecedence "<=" = 1 +getPrecedence ">=" = 1 +getPrecedence "+" = 2 +getPrecedence "-" = 2 +getPrecedence "*" = 3 +getPrecedence "/" = 3 +getPrecedence _ = 0 + +opOnStack :: Value -> ShuntingYardState -> ShuntingYardState +opOnStack (Var op1) (SYS ((Var op2):ops) out) + | prec2 >= prec1 = opOnStack (Var op1) (SYS ops (out ++ [Var op2])) + | otherwise = SYS (Var op2:ops) out + where + prec1 = getPrecedence op1 + prec2 = getPrecedence op2 +opOnStack _ sys = sys + +shuntingYardOp :: Value -> ShuntingYardState -> ShuntingYardState +shuntingYardOp (Var "{") (SYS ops out) = + SYS (Var "{" : ops) out +shuntingYardOp (Var "}") (SYS [] _) = + SYS [] [] +shuntingYardOp (Var "}") (SYS ((Var "{"):ops) out) = + SYS ops out +shuntingYardOp (Var "}") (SYS (op:ops) out) = + shuntingYardOp (Var "}") (SYS ops (out ++ [op])) +shuntingYardOp (Var op) sys = + SYS (Var op:ops') out' + where + (SYS ops' out') = opOnStack (Var op) sys +shuntingYardOp _ _ = SYS [] [] + +shuntingYardEnd :: ShuntingYardState -> ShuntingYardState +shuntingYardEnd (SYS [] out) = SYS [] out +shuntingYardEnd (SYS (op:ops) out) = shuntingYardEnd (SYS ops (out ++ [op])) diff --git a/lvtc/src/Wasm.hs b/lvtc/src/Wasm.hs new file mode 100644 index 0000000..058dd2d --- /dev/null +++ b/lvtc/src/Wasm.hs @@ -0,0 +1,232 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ShuntingYard +-} + +module Wasm +( + VariableType (..) + , TypeSectionType (..) + , TypeSection (..) + , FunctionSection (..) + , MemorySectionLimits (..) + , MemorySection (..) + , ExportSectionExportType (..) + , ExportSectionExport (..) + , ExportSection (..) + , CodeSectionCodeLocals + , CodeSectionCode (..) + , CodeSection (..) + , Wasm (..) +) where + +import WatAST (OpCode (..)) +import Data.Int (Int32) + +pad :: String -> String +pad [] = [] +pad ('\n':xs) = '\n':' ':' ' : pad xs +pad (x:xs) = x : pad xs + +data VariableType = + I32 + deriving (Show, Eq) + +data TypeSectionType = + Func { + headerFunc :: Int, + nbParams :: Int, + params :: [VariableType], + nbResults :: Int, + results :: [VariableType] + } + deriving (Eq) + +instance Show TypeSectionType where + show (Func hF nP p nR r) = + "Func {\n" + ++ " headerFunc: " ++ show hF ++ "\n" + ++ " nbParams: " ++ show nP ++ "\n" + ++ " params: " ++ show p ++ "\n" + ++ " nbResults: " ++ show nR ++ "\n" + ++ " results: " ++ show r ++ "\n" + ++ "}" + +data TypeSection = + TS { + headerTS :: Int, + sizeTS :: Int, + nbTypes :: Int, + types :: [TypeSectionType] + } + deriving (Eq) + +instance Show TypeSection where + show (TS hT sT nT t) = + "TS {\n" + ++ " headerTS: " ++ show hT ++ "\n" + ++ " sizeTS: " ++ show sT ++ "\n" + ++ " nbTypes: " ++ show nT ++ "\n" + ++ " types: " ++ pad (pad (show t)) ++ "\n" + ++ "}" + +data FunctionSection = + FS { + headerFS :: Int, + sizeFS :: Int, + nbFuncs :: Int, + funcs :: [Int] + } + deriving (Eq) + +instance Show FunctionSection where + show (FS hF sF nF f) = + "FS {\n" + ++ " headerFS: " ++ show hF ++ "\n" + ++ " sizeFS: " ++ show sF ++ "\n" + ++ " nbFuncs: " ++ show nF ++ "\n" + ++ " funcs: " ++ pad (pad (show f)) ++ "\n" + ++ "}" + +data MemorySectionLimits = + MSL { + hasMax :: Int, + minMS :: Int, + maxMS :: Int + } + deriving (Eq) + +instance Show MemorySectionLimits where + show (MSL hM mMi mMa) = + "MSL {\n" + ++ " hasMax: " ++ show hM ++ "\n" + ++ " minMS: " ++ show mMi ++ "\n" + ++ " maxMS: " ++ show mMa ++ "\n" + ++ "}" + +data MemorySection = + MS { + headerMS :: Int, + sizeMS :: Int, + nbLimits :: Int, + limits :: [MemorySectionLimits] + } + deriving (Eq) + +instance Show MemorySection where + show (MS hM sM nL l) = + "MS {\n" + ++ " headerMS: " ++ show hM ++ "\n" + ++ " sizeMS: " ++ show sM ++ "\n" + ++ " nbLimits: " ++ show nL ++ "\n" + ++ " limits: " ++ pad (pad (show l)) ++ "\n" + ++ "}" + +data ExportSectionExportType = + FuncExport + | TableExport + | MemoryExport + | GlobalExport + deriving (Show, Eq) + +data ExportSectionExport = + ESE { + nameLength :: Int, + name :: String, + typeESE :: ExportSectionExportType, + indexESE :: Int + } + deriving (Eq) + +instance Show ExportSectionExport where + show (ESE nL n t i) = + "ESE {\n" + ++ " nameLength: " ++ show nL ++ "\n" + ++ " name: " ++ show n ++ "\n" + ++ " typeESE: " ++ show t ++ "\n" + ++ " indexESE: " ++ show i ++ "\n" + ++ "}" + +data ExportSection = + ES { + headerES :: Int, + sizeES :: Int, + nbExports :: Int, + exports :: [ExportSectionExport] + } + deriving (Eq) + +instance Show ExportSection where + show (ES hE sE nE e) = + "ES {\n" + ++ " headerES: " ++ show hE ++ "\n" + ++ " sizeES: " ++ show sE ++ "\n" + ++ " nbExports: " ++ show nE ++ "\n" + ++ " exports: " ++ pad (pad (show e)) ++ "\n" + ++ "}" + +type CodeSectionCodeLocals = (Int32, VariableType) + +data CodeSectionCode = + CSC { + sizeCSC :: Int, + nbLocals :: Int, + locals :: [CodeSectionCodeLocals], + bodyCSC :: [OpCode], + endCSC :: Int + } + deriving (Eq) + +instance Show CodeSectionCode where + show (CSC sL nL l b e) = + "CSC {\n" + ++ " sizeCSC: " ++ show sL ++ "\n" + ++ " nbLocals: " ++ show nL ++ "\n" + ++ " locals: " ++ pad (pad (show l)) ++ "\n" + ++ " bodyCSC: " ++ pad (pad (show b)) ++ "\n" + ++ " endCSC: " ++ show e ++ "\n" + ++ "}" + +data CodeSection = + CS { + headerCS :: Int, + sizeCS :: Int, + nbCodes :: Int, + codes :: [CodeSectionCode] + } + deriving (Eq) + +instance Show CodeSection where + show (CS hC sC nC c) = + "CS {\n" + ++ " headerCS: " ++ show hC ++ "\n" + ++ " sizeCS: " ++ show sC ++ "\n" + ++ " nbCodes: " ++ show nC ++ "\n" + ++ " codes: " ++ pad (pad (show c)) ++ "\n" + ++ "}" + +data Wasm = + Wasm { + headerWasm :: (Int, Int, Int, Int), + versionWasm :: (Int, Int, Int, Int), + typeSection :: TypeSection, + functionSection :: FunctionSection, + memorySection :: MemorySection, + exportSection :: ExportSection, + codeSection :: CodeSection + } + deriving (Eq) + +instance Show Wasm where + show (Wasm h v t f m e c) = + "Wasm {\n" + ++ " headerWasm: " ++ pad (show h) ++ "\n" + ++ " versionWasm: " ++ pad (show v) ++ "\n" + ++ " typeSection: " ++ pad (show t) ++ "\n" + ++ " functionSection: " ++ pad (show f) ++ "\n" + ++ " memorySection: " ++ pad (show m) ++ "\n" + ++ " exportSection: " ++ pad (show e) ++ "\n" + ++ " codeSection: " ++ pad (show c) ++ "\n" + ++ "}" diff --git a/lvtc/src/WasmUtils.hs b/lvtc/src/WasmUtils.hs new file mode 100644 index 0000000..07be5e2 --- /dev/null +++ b/lvtc/src/WasmUtils.hs @@ -0,0 +1,268 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ShuntingYard +-} + +module WasmUtils +( + getDefaultTypeSectionType, + getDefaultTypeSection, + getDefaultFunctionSection, + getDefaultMemorySection, + getDefaultExportSection, + getDefaultCodeSectionCode, + getDefaultCodeSection, + getDefaultWasm, + -- + fillBlankTypeSectionType, + fillBlankTypeSection, + fillBlankFunctionSection, + fillBlankMemorySectionLimits, + fillBlankMemorySection, + fillBlankExportSectionExport, + fillBlankExportSection, + fillBlankCodeSectionCode, + fillBlankCodeSection, + -- + opCodeByte, + variableTypeByte, + exportSectionExportTypeByte, + ifTypeByte +) where + +import Wasm +import WatAST (OpCode (..), IfType (..)) +import Leb128Encode + +getDefaultTypeSectionType :: TypeSectionType +getDefaultTypeSectionType = Func { + headerFunc = 0x60, + nbParams = 0x0, + params = [], + nbResults = 0, + results = [] +} + +fillBlankTypeSectionType :: TypeSectionType -> TypeSectionType +fillBlankTypeSectionType (Func hF _ p _ r) = + Func { + headerFunc = hF, + nbParams = length p, + params = p, + nbResults = length r, + results = r + } + +getSizeTypeSectionType :: TypeSectionType -> Int +getSizeTypeSectionType (Func _ _ p _ r) = + 1 + 1 + ((length p) * 1) + 1 + ((length r) * 1) + +getDefaultTypeSection :: TypeSection +getDefaultTypeSection = TS { + headerTS = 0x01, + sizeTS = 0x0, + nbTypes = 0, + types = [] +} + +fillBlankTypeSection :: TypeSection -> TypeSection +fillBlankTypeSection (TS hT _ _ t) = + TS { + headerTS = hT, + sizeTS = size, + nbTypes = length t, + types = t + } + where + size = 1 + sum (map getSizeTypeSectionType t) + +getDefaultFunctionSection :: FunctionSection +getDefaultFunctionSection = FS { + headerFS = 0x03, + sizeFS = 0x0, + nbFuncs = 0, + funcs = [] +} + +fillBlankFunctionSection :: FunctionSection -> FunctionSection +fillBlankFunctionSection (FS hF _ _ f) = + FS { + headerFS = hF, + sizeFS = size, + nbFuncs = length f, + funcs = f + } + where + size = 1 + ((length f) * 1) + +getDefaultMemorySection :: MemorySection +getDefaultMemorySection = MS { + headerMS = 0x05, + sizeMS = 0x0, + nbLimits = 0, + limits = [] +} + +fillBlankMemorySectionLimits :: MemorySectionLimits -> MemorySectionLimits +fillBlankMemorySectionLimits (MSL 0 miMS maMS) = + MSL { + hasMax = 0, + minMS = miMS, + maxMS = maMS + } +fillBlankMemorySectionLimits (MSL _ miMS maMS) = + MSL { + hasMax = 1, + minMS = miMS, + maxMS = maMS + } + +getSizeMemorySectionLimits :: MemorySectionLimits -> Int +getSizeMemorySectionLimits (MSL 0 _ _) = 1 + 1 +getSizeMemorySectionLimits (MSL _ _ _) = 1 + 1 + 1 + +fillBlankMemorySection :: MemorySection -> MemorySection +fillBlankMemorySection (MS hM _ _ m) = + MS { + headerMS = hM, + sizeMS = size, + nbLimits = length m, + limits = m + } + where + size = 1 + sum (map getSizeMemorySectionLimits m) + +fillBlankExportSectionExport :: ExportSectionExport -> ExportSectionExport +fillBlankExportSectionExport (ESE _ n t i) = + ESE { + nameLength = length n, + name = n, + typeESE = t, + indexESE = i + } + +getSizeExportSectionExport :: ExportSectionExport -> Int +getSizeExportSectionExport (ESE _ n _ _) = + (length (leb128Encode (length n))) + (length n) + 1 + 1 + +getDefaultExportSection :: ExportSection +getDefaultExportSection = ES { + headerES = 0x07, + sizeES = 0x0, + nbExports = 0, + exports = [] +} + +fillBlankExportSection :: ExportSection -> ExportSection +fillBlankExportSection (ES hE _ _ e) = + ES { + headerES = hE, + sizeES = size, + nbExports = length e, + exports = e + } + where + size = 1 + sum (map (getSizeExportSectionExport) e) + +getDefaultCodeSectionCode :: CodeSectionCode +getDefaultCodeSectionCode = CSC { + sizeCSC = 0x0, + nbLocals = 0, + locals = [], + bodyCSC = [], + endCSC = 0x0b +} + +getSizeOpCode :: OpCode -> Int +getSizeOpCode (LocalGet _) = 2 +getSizeOpCode (LocalSet _) = 2 +getSizeOpCode (I32Const _) = 2 +getSizeOpCode (Call _) = 2 +getSizeOpCode (If _) = 2 +getSizeOpCode _ = 1 + +fillBlankCodeSectionCode :: CodeSectionCode -> CodeSectionCode +fillBlankCodeSectionCode (CSC _ _ l b e) = + CSC { + sizeCSC = size, + nbLocals = length l, + locals = l, + bodyCSC = b, + endCSC = e + } + where + size = 1 + ((length l) * 2) + (sum (map getSizeOpCode b)) + 1 + +getDefaultCodeSection :: CodeSection +getDefaultCodeSection = CS { + headerCS = 0x0a, + sizeCS = 0x0, + nbCodes = 0, + codes = [] +} + +getSizeCodeSectionCode :: CodeSectionCode -> Int +getSizeCodeSectionCode csc = lN + s + where + newCsc = fillBlankCodeSectionCode csc + s = sizeCSC newCsc + lN = length (leb128Encode s) + +fillBlankCodeSection :: CodeSection -> CodeSection +fillBlankCodeSection (CS hC _ _ c) = + CS { + headerCS = hC, + sizeCS = size, + nbCodes = length c, + codes = c + } + where + size1 = sum (map getSizeCodeSectionCode c) + size = size1 + 1 + +getDefaultWasm :: Wasm +getDefaultWasm = Wasm { + headerWasm = (0x00, 0x61, 0x73, 0x6d), + versionWasm = (0x01, 0x00, 0x00, 0x00), + typeSection = getDefaultTypeSection, + functionSection = getDefaultFunctionSection, + memorySection = getDefaultMemorySection, + exportSection = getDefaultExportSection, + codeSection = getDefaultCodeSection +} + +opCodeByte :: OpCode -> Int +opCodeByte (LocalGet _) = 0x20 +opCodeByte (LocalSet _) = 0x21 +opCodeByte (I32Const _) = 0x41 +opCodeByte I32Store = 0x36 +opCodeByte I32Load = 0x28 +opCodeByte I32GT_S = 0x4a +opCodeByte I32LT_S = 0x48 +opCodeByte I32GE_S = 0x4e +opCodeByte I32LE_S = 0x4c +opCodeByte I32EQ = 0x46 +opCodeByte I32NE = 0x47 +opCodeByte I32Add = 0x6a +opCodeByte I32Sub = 0x6b +opCodeByte I32Mul = 0x6c +opCodeByte I32Div = 0x6d +opCodeByte Return = 0x0f +opCodeByte (Call _) = 0x10 +opCodeByte (If EmptyType) = 0x04 +opCodeByte Else = 0x05 +opCodeByte End = 0x0b + +ifTypeByte :: IfType -> Int +ifTypeByte EmptyType = 0x40 + +variableTypeByte :: VariableType -> Int +variableTypeByte I32 = 0x7f + +exportSectionExportTypeByte :: ExportSectionExportType -> Int +exportSectionExportTypeByte (FuncExport) = 0x00 +exportSectionExportTypeByte (TableExport) = 0x01 +exportSectionExportTypeByte (MemoryExport) = 0x02 +exportSectionExportTypeByte (GlobalExport) = 0x03 diff --git a/lvtc/src/WatAST.hs b/lvtc/src/WatAST.hs new file mode 100644 index 0000000..91b353b --- /dev/null +++ b/lvtc/src/WatAST.hs @@ -0,0 +1,75 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ShuntingYard +-} + +module WatAST +( + OpCode (..) + , Type (..) + , FuncDef (..) + , IfType (..) +) where + +import Data.Int (Int32) + +data IfType = + EmptyType + deriving (Show, Eq) + +-- if opcode added, dont miss to add the right size in ./WasmUtils.hs +data OpCode = + LocalGet Int32 + | LocalSet Int32 + | I32Const Int32 + | I32Store + | I32Load + | I32GT_S + | I32GE_S + | I32LT_S + | I32LE_S + | I32EQ + | I32NE + | I32Add + | I32Sub + | I32Mul + | I32Div + | Return + | Call Int32 + | If IfType + | Else + | End + deriving (Show, Eq) + +data Type = + I32 + +instance Show Type where + show I32 = "i32" + +instance Eq Type where + (==) I32 I32 = True + +data FuncDef = + FuncDef Bool String Int32 [Type] Type [OpCode] [(Type, Int32)] + +instance Show FuncDef where + show (FuncDef True name indexName paramsType returnType bodyCode vars) = + "export fn " ++ show name ++ "{" ++ show indexName ++ "}(" + ++ show paramsType ++ ") -> " ++ show returnType ++ " {\n" + ++ show bodyCode ++ "\n}\n" ++ show vars + show (FuncDef False name indexName paramsType returnType bodyCode vars) = + "fn " ++ show name ++ "{" ++ show indexName ++ "}(" + ++ show paramsType ++ ") -> " ++ show returnType ++ " {\n" + ++ show bodyCode ++ "\n}\n" ++ show vars + +instance Eq FuncDef where + (==) (FuncDef aa aaa a b c d e) (FuncDef aa' aaa' a' b' c' d' e') = + aa == aa' && aaa == aaa' && a == a' + && b == b' && c == c' && d == d' && e == e' + +instance Ord FuncDef where + compare (FuncDef _ _ ind _ _ _ _) (FuncDef _ _ ind' _ _ _ _) = + compare ind ind' diff --git a/lvtc/src/WatLike.hs b/lvtc/src/WatLike.hs new file mode 100644 index 0000000..0306fc3 --- /dev/null +++ b/lvtc/src/WatLike.hs @@ -0,0 +1,322 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- WatLike +-} + +module WatLike +( + FuncDeclare + , Index + , aSTToWatLike +) where + +import AST +import Builtins + +import Data.Int (Int32) +import Data.Char (ord) + +------------------------------------------------------------------------------ +-- Named Index Vars / Func + +type Index = (Int, String) +type FuncDeclare = (FuncDeclaration, [Index], String) + +getRegisterIndex' :: Int -> String -> [Index] -> ([Index], Int) +getRegisterIndex' maxInd var [] = ([(maxInd, var)], maxInd) +getRegisterIndex' maxInd var (x:xs) + | var == snd x = (x:xs, fst x) + | maxInd > fst x = (x : inds, ind) + | otherwise = (x : inds', ind') + where + (inds, ind) = getRegisterIndex' maxInd var xs + (inds', ind') = getRegisterIndex' (fst x + 1) var xs + +getRegisterIndex :: String -> [Index] -> ([Index], Int) +getRegisterIndex = getRegisterIndex' 0 + +newIndex' :: Int -> [Index] -> ([Index], Int) +newIndex' maxInd [] = ([(maxInd, "_tmpValue")], maxInd) +newIndex' maxInd (x:xs) + | maxInd > fst x = (x : inds, ind) + | otherwise = (x : inds', ind') + where + (inds, ind) = newIndex' maxInd xs + (inds', ind') = newIndex' (fst x + 1) xs + +newIndex :: [Index] -> ([Index], Int) +newIndex = newIndex' 0 + +modifyAllValue :: [Value] -> [Index] -> [Index] -> ([Value], [Index], [Index]) +modifyAllValue [] varsIndex funcsIndex = ([], varsIndex, funcsIndex) +modifyAllValue (x:xs) varsIndex funcsIndex = + (val:vals, varsIndex'', funcsIndex'') + where + (val, varsIndex', funcsIndex') = modifyAll' x varsIndex funcsIndex + (vals, varsIndex'', funcsIndex'') = + modifyAllValue xs varsIndex' funcsIndex' + +modifyAll' :: Value -> [Index] -> [Index] -> (Value, [Index], [Index]) +modifyAll' (FuncValue (fName, vals)) varsIndex funcsIndex = + (newFunc, varsIndex'', funcsIndex'') + where + (funcsIndex', indFunc) = getRegisterIndex fName funcsIndex + (vals', varsIndex'', funcsIndex'') = + modifyAllValue vals varsIndex funcsIndex' + newFunc = FuncValue (show indFunc, vals') +modifyAll' (Var vName) varsIndex funcsIndex = (newVar, varsIndex', funcsIndex) + where + (varsIndex', indVar) = getRegisterIndex vName varsIndex + newVar = Var (show indVar) +modifyAll' x varsIndex funcsIndex = (x, varsIndex, funcsIndex) + +--- + +modifyAll :: [Instruction] -> [Index] -> [Index] + -> ([Instruction], [Index], [Index]) +modifyAll [] varsIndex funcsIndex = ([], varsIndex, funcsIndex) +modifyAll ((Function (fName, vals)):xs) varsIndex funcsIndex = + (newFunc:ins', varsIndex''', funcsIndex''') + where + (funcsIndex', indFunc) = getRegisterIndex fName funcsIndex + (vals', varsIndex'', funcsIndex'') = + modifyAllValue vals varsIndex funcsIndex' + newFunc = Function (show indFunc, vals') + (ins', varsIndex''', funcsIndex''') = + modifyAll xs varsIndex'' funcsIndex'' +modifyAll ((Return vValue):xs) varsIndex funcsIndex = + (newReturn:ins', varsIndex'', funcsIndex'') + where + (vValue', varsIndex', funcsIndex') = + modifyAll' vValue varsIndex funcsIndex + newReturn = Return vValue' + (ins', varsIndex'', funcsIndex'') = modifyAll xs varsIndex' funcsIndex' +modifyAll ((Declaration ((vName, vTyp), vValue)):xs) varsIndex funcsIndex = + (newDeclaration : ins', varsIndex''', funcsIndex''') + where + (varsIndex', ind) = getRegisterIndex vName varsIndex + (vValue'', varsIndex'', funcsIndex'') = + modifyAll' vValue varsIndex' funcsIndex + newDeclaration = Declaration ((show ind, vTyp), vValue'') + (ins', varsIndex''', funcsIndex''') = + modifyAll xs varsIndex'' funcsIndex'' +modifyAll ((Assignation (vName, vValue)):xs) varsIndex funcsIndex = + (newAssignation:ins', varsIndex''', funcsIndex''') + where + (varsIndex', ind) = getRegisterIndex vName varsIndex + (vValue', varsIndex'', funcsIndex'') = + modifyAll' vValue varsIndex' funcsIndex + newAssignation = Assignation (show ind, vValue') + (ins', varsIndex''', funcsIndex''') = + modifyAll xs varsIndex'' funcsIndex'' +modifyAll ((Cond (vValue, insIf, insElse)):xs) vsInd fsInd = + (newCond:ins', vsInd'''', fsInd'''') + where + (vValue', vsInd', fsInd') = modifyAll' vValue vsInd fsInd + (insIf', vsInd'', fsInd'') = modifyAll insIf vsInd' fsInd' + (insElse', vsInd''', fsInd''') = modifyAll insElse vsInd'' fsInd'' + newCond = Cond (vValue', insIf', insElse') + (ins', vsInd'''', fsInd'''') = modifyAll xs vsInd''' fsInd''' + +transformType :: Type -> Type +transformType "Void" = "Int" +transformType "Char" = "Int" +transformType "Bool" = "Int" +transformType x = x + +registerParams :: FuncDeclare -> FuncDeclare +registerParams (((isExp, fName, [], typ), ins), varsIndex, oName) = + (((isExp, fName, [], transformType typ), ins), varsIndex, oName) +registerParams (((isExp, fName, (pName, pTyp):vParams, typ) + , ins), varsIndex, oName) = + (((isExp, fName', newParams:vParams', vTyp'), ins), varsIndex'', oName) + where + (varsIndex', indVar) = getRegisterIndex pName varsIndex + (((_, fName', vParams', vTyp'), _), varsIndex'', _) = + registerParams (((isExp, fName, vParams, typ), ins) + , varsIndex', oName) + newParams = (show indVar, transformType pTyp) + +registerAllFuncs :: [FuncDeclaration] -> [Index] -> [Index] +registerAllFuncs [] funcsIndex = funcsIndex +registerAllFuncs (((_, fName, _, _), _):xs) funcsIndex = funcsIndex'' + where + (funcsIndex', _) = getRegisterIndex fName funcsIndex + funcsIndex'' = registerAllFuncs xs funcsIndex' + +changeIndexes :: [FuncDeclaration] -> [Index] -> ([FuncDeclare], [Index]) +changeIndexes [] funcsIndex = ([], funcsIndex) +changeIndexes (((isExp, fName, vars, typ), ins):xs) funcsIndex = + (newFunc:funcs, funcsIndex''') + where + (funcsIndex', iFunc) = getRegisterIndex fName funcsIndex + (((_, _, vars', typ'), ins'), vIndex, _) = + registerParams (((isExp, fName, vars, typ), ins), [], fName) + (ins'', vIndex'', funcsIndex'') = + modifyAll ins' vIndex funcsIndex' + newFunc = (((isExp, show iFunc, vars', typ'), ins''), vIndex'', fName) + (funcs, funcsIndex''') = changeIndexes xs funcsIndex'' + +------------------------------------------------------------------------------ + +data WatLikeState = WLS [Index] [FuncDeclare] [FuncDeclare] + +instance Eq WatLikeState where + (==) (WLS x y z) (WLS x' y' z') = x == x' && y == y' && z == z' + +instance Show WatLikeState where + show (WLS x y z) = + "WLS[[ " ++ show x ++ " ][ " ++ show y ++ " ][ " ++ show z ++ " ]]" + +------------------------------------------------------------------------------ + +getPrototype :: String -> [FuncDeclare] -> FuncPrototype +getPrototype _ [] = undefined +getPrototype fName ((((isExp, fName', vars, typ), _), _, _):xs) + | fName == fName' = (isExp, fName', vars, typ) + | otherwise = getPrototype fName xs + +------------------------------------------------------------------------------ + +funcCallToWatLike :: FuncCall -> ([FuncDeclare], [Index]) -> [Index] + -> ([Index], [Instruction], FuncCall) +funcCallToWatLike (fName, []) _ varsIndex = (varsIndex, [], (fName, [])) +funcCallToWatLike (fName, vVal:vVals) oldFuncs varsIndex = + (varsIndex'', ins ++ inss, (fName, vVal':vVals')) + where + (varsIndex', ins, vVal') = valueToWatLike vVal oldFuncs varsIndex + (varsIndex'', inss, (_, vVals')) = + funcCallToWatLike (fName, vVals) oldFuncs varsIndex' + +valueToWatLike :: Value -> ([FuncDeclare], [Index]) -> [Index] + -> ([Index], [Instruction], Value) +valueToWatLike (FuncValue x) (oldFuncs, funcsIndex) varsIndex = + (varsIndex'', ins ++ [newDeclaration], Var (show indVar)) + where + (varsIndex', ins, (fName, vVals)) = + funcCallToWatLike x (oldFuncs, funcsIndex) varsIndex + (varsIndex'', indVar) = newIndex varsIndex' + (_, _, _, typ) = getPrototype fName oldFuncs + newDeclaration = + Declaration ((show indVar, typ), FuncValue (fName, vVals)) +valueToWatLike (Boolean True) _ varsIndex = + (varsIndex', [newDeclaration], Var (show indVar)) + where + (varsIndex', indVar) = newIndex varsIndex + newDeclaration = Declaration ((show indVar, "Int"), Integer 1) +valueToWatLike (Boolean False) _ varsIndex = + (varsIndex', [newDeclaration], Var (show indVar)) + where + (varsIndex', indVar) = newIndex varsIndex + newDeclaration = Declaration ((show indVar, "Int"), Integer 0) +valueToWatLike (Character x) _ varsIndex = + (varsIndex', [newDeclaration], Var (show indVar)) + where + (varsIndex', indVar) = newIndex varsIndex + ordChar = read (show (ord x)) :: Int32 + newDeclaration = Declaration ((show indVar, "Int"), Integer ordChar) +valueToWatLike (StringView _) _ _ = error "StringView not implemented for now" +valueToWatLike Void _ varsIndex = + (varsIndex', [newDeclaration], Var (show indVar)) + where + (varsIndex', indVar) = newIndex varsIndex + newDeclaration = Declaration ((show indVar, "Int"), Integer 0) +valueToWatLike (Integer x) _ varsIndex = + (varsIndex', [newDeclaration], Var (show indVar)) + where + (varsIndex', indVar) = newIndex varsIndex + newDeclaration = Declaration ((show indVar, "Int"), Integer x) +valueToWatLike (Var x) _ varsIndex = (varsIndex, [], Var x) + +instructionToWatLike :: Instruction -> ([FuncDeclare], [Index]) -> [Index] + -> ([Index], [Instruction]) +instructionToWatLike + (Declaration ((vName, vTyp), vValue)) oldFuncs varsIndex = + (varsIndex', ins' ++ [newDeclaration]) + where + (varsIndex', ins', vValue') = valueToWatLike vValue oldFuncs varsIndex + newDeclaration = Declaration ((vName, vTyp), vValue') +instructionToWatLike + (Assignation (vName, vValue)) oldFuncs varsIndex = + (varsIndex', ins' ++ [newAssignation]) + where + (varsIndex', ins', vValue') = valueToWatLike vValue oldFuncs varsIndex + newAssignation = Assignation (vName, vValue') +instructionToWatLike + (Function (fName, fParams)) oldFuncs varsIndex = + (varsIndex', ins' ++ [newFunction]) + where + (varsIndex', ins', (_, fParams')) = + funcCallToWatLike (fName, fParams) oldFuncs varsIndex + newFunction = Function (fName, fParams') +instructionToWatLike + (Return vValue) oldFuncs varsIndex = + (varsIndex', ins' ++ [newReturn]) + where + (varsIndex', ins', vValue') = valueToWatLike vValue oldFuncs varsIndex + newReturn = Return vValue' +instructionToWatLike + (Cond (vValCond, vInsTrue, vInsFalse)) oldFuncs vsInd = + (vsInd''', insCond ++ [newCond]) + where + (vsInd', insCond, vValCond') = valueToWatLike vValCond oldFuncs vsInd + (vsInd'', vInsTrue') = instructionsToWatLike vInsTrue oldFuncs vsInd' + (vsInd''', vInsFalse') = + instructionsToWatLike vInsFalse oldFuncs vsInd'' + newCond = Cond (vValCond', vInsTrue', vInsFalse') + +instructionsToWatLike :: [Instruction] -> ([FuncDeclare], [Index]) + -> [Index] -> ([Index], [Instruction]) +instructionsToWatLike [] _ varsIndex = (varsIndex, []) +instructionsToWatLike (x:xs) oldFuncs varsIndex = + (varsIndex'', ins ++ inss) + where + (varsIndex', ins) = instructionToWatLike x oldFuncs varsIndex + (varsIndex'', inss) = instructionsToWatLike xs oldFuncs varsIndex' + +------------------------------------------------------------------------------ + +funcToWatLike' :: FuncDeclare -> ([FuncDeclare], [Index]) -> FuncDeclare +funcToWatLike' (((isExp, fName, fParams, fRet), []), varsIndex, oName) _ = + (((isExp, fName, fParams, fRet), []), varsIndex, oName) +funcToWatLike' (((isExp, fName, fParams, fRet), ins:inss), + varsIndex, oName) oldFuncs = + (((isExp, fName, fParams, fRet), ins' ++ inss'), varsIndex'', oName) + where + (varsIndex', ins') = instructionToWatLike ins oldFuncs varsIndex + thisFunc = (((isExp, fName, fParams, fRet), inss), varsIndex', oName) + (((_, _, _, _), inss'), varsIndex'', _) = + funcToWatLike' thisFunc oldFuncs + +funcToWatLike :: FuncDeclare -> WatLikeState -> WatLikeState +funcToWatLike (((isExp, fName, fParams, fRet), fInss), varsIndex, originName) + (WLS funcsIndex oldFuncs newFunc) = + WLS funcsIndex oldFuncs (newFunc ++ [fFunc]) + where + fFunc = funcToWatLike' + (((isExp, fName, fParams, fRet), fInss), varsIndex, originName) + (oldFuncs, funcsIndex) + +------------------------------------------------------------------------------ + +aSTToWatLike' :: [FuncDeclare] -> WatLikeState -> WatLikeState +aSTToWatLike' [] (WLS funcsIndex oldFunc newFunc) = + WLS funcsIndex oldFunc newFunc +aSTToWatLike' (func:xs) + (WLS funcsIndex oldFunc newFunc) = + aSTToWatLike' xs (WLS funcsIndex' oldFunc newFunc') + where + (WLS funcsIndex' _ newFunc') = + funcToWatLike + func + (WLS funcsIndex oldFunc newFunc) + +aSTToWatLike :: [FuncDeclaration] -> [FuncDeclare] +aSTToWatLike funcs = newFunc + where + allFuncs = getBuiltinsFunc ++ funcs + funcsIndex = registerAllFuncs allFuncs [] + (funcs', funcsIndex') = changeIndexes allFuncs funcsIndex + (WLS _ _ newFunc) = aSTToWatLike' funcs' (WLS funcsIndex' funcs' []) diff --git a/lvtc/src/WatLikeToWat.hs b/lvtc/src/WatLikeToWat.hs new file mode 100644 index 0000000..5279a04 --- /dev/null +++ b/lvtc/src/WatLikeToWat.hs @@ -0,0 +1,136 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ShuntingYard +-} + +module WatLikeToWat +( + watLikeToWat + , watsLikeToWat +) where + +import Data.Int (Int32) + +import WatAST +import WatLike +import AST +import Builtins + +typeStringToType :: Symbol -> WatAST.Type +typeStringToType "Int" = I32 +typeStringToType _ = error "Unknown type" + +paramsToTypes :: [Var] -> [WatAST.Type] +paramsToTypes [] = [] +paramsToTypes ((_, t):vars) = typeStringToType t : paramsToTypes vars + +nameIsInParams :: String -> [Var] -> Bool +nameIsInParams _ [] = False +nameIsInParams name ((name', _):xs) + | name == name' = True + | otherwise = nameIsInParams name xs + +findTypeFromInstructions :: String -> [Instruction] -> WatAST.Type +findTypeFromInstructions name [] = error ("Type not found for: " ++ name) +findTypeFromInstructions name ((Declaration ((name', typ), _)):xs) + | name == name' = typeStringToType typ + | otherwise = findTypeFromInstructions name xs +findTypeFromInstructions name ((Cond (_, insIf, insElse)):xs) = + findTypeFromInstructions name (insIf ++ insElse ++ xs) +findTypeFromInstructions name (_:xs) = findTypeFromInstructions name xs + +varsToDecl :: [Index] -> [Instruction] -> [Var] -> [(WatAST.Type, Int32)] +varsToDecl [] _ _ = [] +varsToDecl ((nameIndex, _):xs) ins params + | nameIsInParams ind params = varsToDecl xs ins params + | otherwise = + (findTypeFromInstructions ind ins, 1) : varsToDecl xs ins params + where + ind = show nameIndex + +groupVarsToDecl :: [(WatAST.Type, Int32)] -> [(WatAST.Type, Int32)] +groupVarsToDecl [] = [] +groupVarsToDecl [x] = [x] +groupVarsToDecl ((t, nb):(t', nb'):vars) + | t == t' = groupVarsToDecl ((t, nb + nb'):vars) + | otherwise = (t, nb) : groupVarsToDecl ((t', nb'):vars) + +valueToWat :: Value -> [OpCode] +valueToWat (Var name) = + [ + LocalGet (read name :: Int32) + ] +valueToWat (Integer value) = + [ + I32Const value + ] +valueToWat (FuncValue (indexName, values)) = + valuesToWat values + ++ [ + Call (read indexName :: Int32) + ] +valueToWat _ = error "value not supported" + +valuesToWat :: [Value] -> [OpCode] +valuesToWat = concatMap valueToWat + +instructionToWat :: Instruction -> [OpCode] +instructionToWat (AST.Return (Var indexName)) = + [ + LocalGet (read indexName :: Int32) + , WatAST.Return + ] +instructionToWat (AST.Return _) = error "Return need a var" +instructionToWat (Declaration ((indexName, _), val)) = + valueToWat val + ++ [ + LocalSet (read indexName :: Int32) + ] +instructionToWat (Assignation (indexName, val)) = + valueToWat val + ++ [ + LocalSet (read indexName :: Int32) + ] +instructionToWat (Function (indexName, values)) = + valuesToWat values + ++ [ + Call (read indexName :: Int32) + ] +instructionToWat (Cond (value, ifTrue, [])) = + valueToWat value + ++ [ If EmptyType ] + ++ instructionsToWat ifTrue + ++ [ End ] +instructionToWat (Cond (value, ifTrue, ifFalse)) = + valueToWat value + ++ [ If EmptyType ] + ++ instructionsToWat ifTrue + ++ [ Else ] + ++ instructionsToWat ifFalse + ++ [ End ] + +instructionsToWat :: [Instruction] -> [OpCode] +instructionsToWat = concatMap instructionToWat +-- +-- instructionsToWat = foldr ((++) . instructionToWat) [] +-- +-- instructionsToWat xs = foldr ((++) . instructionToWat) [] xs +-- +-- instructionsToWat [] = [] +-- instructionsToWat (x:xs) = instructionToWat x ++ instructionsToWat xs + +watLikeToWat :: FuncDeclare -> FuncDef +watLikeToWat (((isExp, fName, params, returnType), ins), vars, originName) + | isBuiltinsFunc fName = getBuiltinWat fName + | otherwise = FuncDef isExp originName iName pType rType opcodes vDecl + where + iName = read fName :: Int32 + pType = paramsToTypes params + rType = typeStringToType returnType + vDecl = groupVarsToDecl $ varsToDecl vars ins params + opcodes = instructionsToWat ins + +watsLikeToWat :: [FuncDeclare] -> [FuncDef] +watsLikeToWat = map watLikeToWat diff --git a/lvtc/src/WatToWasm.hs b/lvtc/src/WatToWasm.hs new file mode 100644 index 0000000..342d55a --- /dev/null +++ b/lvtc/src/WatToWasm.hs @@ -0,0 +1,135 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- WatToWasm +-} + +module WatToWasm +( + watToWasm +) where + +import Wasm +import WasmUtils +import WatAST + +import Data.List (sort) + +watASTTypeToWasm :: Type -> VariableType +watASTTypeToWasm WatAST.I32 = Wasm.I32 + +-- Type Section + +addFuncToType :: FuncDef -> [([Type], Type)] -> [([Type], Type)] +addFuncToType (FuncDef _ _ _ p r _ _) [] = [(p, r)] +addFuncToType (FuncDef i o n p r b l) ((p', r'):xs) + | p == p' && r == r' = (p', r') : xs + | otherwise = (p', r') : addFuncToType (FuncDef i o n p r b l) xs + +funcDefsToTypeSectionType' :: [FuncDef] -> [([Type], Type)] -> [([Type], Type)] +funcDefsToTypeSectionType' [] tSection = tSection +funcDefsToTypeSectionType' (x:xs) tSection = + funcDefsToTypeSectionType' xs tSection' + where + tSection' = addFuncToType x tSection + +toTypeSectionType :: ([Type], Type) -> TypeSectionType +toTypeSectionType (p, r) = + fillBlankTypeSectionType (getDefaultTypeSectionType { + params = map watASTTypeToWasm p, + results = [watASTTypeToWasm r] + }) + +funcDefsToTypeSectionType :: [FuncDef] -> [TypeSectionType] +funcDefsToTypeSectionType fs = map toTypeSectionType tSection + where + tSection = funcDefsToTypeSectionType' fs [] + +funcDefsToTypeSection :: [FuncDef] -> TypeSection +funcDefsToTypeSection f = + fillBlankTypeSection (getDefaultTypeSection { + types = funcDefsToTypeSectionType f + }) + +-- Function Section + +getIndexType :: [([Type], Type)] -> Int -> FuncDef -> Int +getIndexType [] _ (FuncDef _ oName _ _ _ _ _) = + error ("No Type in type section: " ++ oName) +getIndexType ((p', r'):xs) ind (FuncDef i o n p r b l) + | p == p' && r == r' = ind + | otherwise = getIndexType xs (ind + 1) (FuncDef i o n p r b l) + +funcDefsToFunctionSection :: [FuncDef] -> FunctionSection +funcDefsToFunctionSection fs = + fillBlankFunctionSection (getDefaultFunctionSection { + funcs = map (getIndexType tSection 0) fs + }) + where + tSection = funcDefsToTypeSectionType' fs [] + +-- Memory Section + +funcDefsToMemorySection :: [FuncDef] -> MemorySection +funcDefsToMemorySection _ = + fillBlankMemorySection (getDefaultMemorySection { + limits = [ + fillBlankMemorySectionLimits (MSL { + hasMax = 0, + minMS = 1, + maxMS = 0 + }) + ] + }) + +-- Export Section + +funcDefsToExportSectionExport :: [FuncDef] -> [ExportSectionExport] +funcDefsToExportSectionExport [] = [] +funcDefsToExportSectionExport ((FuncDef True oName oInd _ _ _ _):xs) = + fillBlankExportSectionExport (ESE { + nameLength = 0, + name = oName, + typeESE = FuncExport, + indexESE = read (show oInd) :: Int + }) : funcDefsToExportSectionExport xs +funcDefsToExportSectionExport (_:xs) = funcDefsToExportSectionExport xs + +funcDefsToExportSection :: [FuncDef] -> ExportSection +funcDefsToExportSection fs = + fillBlankExportSection (getDefaultExportSection { + exports = funcDefsToExportSectionExport fs + }) + +-- Code Section + +funcDefToCodeSectionCode :: FuncDef -> CodeSectionCode +funcDefToCodeSectionCode (FuncDef _ _ _ _ _ b l) = + fillBlankCodeSectionCode (getDefaultCodeSectionCode { + locals = map (\(x, y) -> (y, watASTTypeToWasm x)) l, + bodyCSC = b + }) + +funcDefsToCodeSection :: [FuncDef] -> CodeSection +funcDefsToCodeSection f = + fillBlankCodeSection (getDefaultCodeSection { + codes = map funcDefToCodeSectionCode f + }) + +-- main + +sortFuncDef :: [FuncDef] -> [FuncDef] +sortFuncDef = sort + +watToWasm :: [FuncDef] -> Wasm +watToWasm fs = + getDefaultWasm { + typeSection = funcDefsToTypeSection fsSorted, + functionSection = funcDefsToFunctionSection fsSorted, + memorySection = funcDefsToMemorySection fsSorted, + exportSection = funcDefsToExportSection fsSorted, + codeSection = funcDefsToCodeSection fsSorted + } + where + fsSorted = sortFuncDef fs diff --git a/lvtc/src/WriteWasm.hs b/lvtc/src/WriteWasm.hs new file mode 100644 index 0000000..8182161 --- /dev/null +++ b/lvtc/src/WriteWasm.hs @@ -0,0 +1,166 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- WriteWasm +-} + +module WriteWasm +( + writeWasm + , wasmToByteString +) where + +import Wasm +import WasmUtils +import Leb128Encode +import qualified Data.ByteString as B +import WatAST (OpCode (..)) +import Data.Char (ord) + +-- extend + +extendBytes :: B.ByteString -> [B.ByteString] -> B.ByteString +extendBytes = foldl B.append + +extendsBytes :: B.ByteString -> [[B.ByteString]] -> B.ByteString +extendsBytes = foldl extendBytes + +-- + +headerWasmToByteString :: Wasm -> B.ByteString +headerWasmToByteString (Wasm (a, b, c, d) (e, f, g, h) _ _ _ _ _) = + B.pack (map fromIntegral [a, b, c, d, e, f, g, h]) + +-- + +typeSectionTypeToByteString :: TypeSectionType -> B.ByteString +typeSectionTypeToByteString (Func a b lc d le) = + extendBytes + (B.pack (map fromIntegral [a, b])) + [ + B.pack (map (fromIntegral . variableTypeByte) lc), + B.pack [fromIntegral d], + B.pack (map (fromIntegral . variableTypeByte) le) + ] + +typeSectionToByteString :: TypeSection -> B.ByteString +typeSectionToByteString (TS a b c ld) = + extendsBytes + (B.pack [fromIntegral a]) + [ + [B.pack (map fromIntegral (leb128Encode b))], + [B.pack [fromIntegral c]], + map typeSectionTypeToByteString ld + ] + +-- + +functionSectionToByteString :: FunctionSection -> B.ByteString +functionSectionToByteString (FS a b c ld) = + extendBytes + (B.pack [fromIntegral a]) + [ + B.pack (map (fromIntegral) (leb128Encode b)), + B.pack [fromIntegral c], + B.pack (map fromIntegral ld) + ] + +-- + +memorySectionLimitToByteString :: MemorySectionLimits -> B.ByteString +memorySectionLimitToByteString (MSL 0 a _) = + B.pack [0, fromIntegral a] +memorySectionLimitToByteString (MSL _ a b) = + B.pack [0, fromIntegral a, fromIntegral b] + +memorySectionToByteString :: MemorySection -> B.ByteString +memorySectionToByteString (MS a b c ld) = + extendsBytes + (B.pack [fromIntegral a]) + [ + [B.pack (map fromIntegral (leb128Encode b))], + [B.pack [fromIntegral c]], + map memorySectionLimitToByteString ld + ] + +-- + +exportSectionExportToByteString :: ExportSectionExport -> B.ByteString +exportSectionExportToByteString (ESE a lb c d) = + extendBytes + (B.pack (map fromIntegral (leb128Encode a))) + [ + B.pack (map (fromIntegral . ord) lb), + B.pack [ + fromIntegral (exportSectionExportTypeByte c), + fromIntegral d + ] + ] + +exportSectionToByteString :: ExportSection -> B.ByteString +exportSectionToByteString (ES a b c ld) = + extendsBytes + (B.pack [fromIntegral a]) + [ + [B.pack (map fromIntegral (leb128Encode b))], + [B.pack [fromIntegral c]], + map exportSectionExportToByteString ld + ] + +-- + +codeSectionCodeLocalsToByte :: CodeSectionCodeLocals -> B.ByteString +codeSectionCodeLocalsToByte (a, b) = + B.pack [fromIntegral a, fromIntegral (variableTypeByte b)] + +opCodeToByte :: OpCode -> B.ByteString +opCodeToByte (LocalGet a) = + B.pack [fromIntegral (opCodeByte (LocalGet a)), fromIntegral a] +opCodeToByte (LocalSet a) = + B.pack [fromIntegral (opCodeByte (LocalSet a)), fromIntegral a] +opCodeToByte (I32Const a) = + B.pack [fromIntegral (opCodeByte (I32Const a)), fromIntegral a] +opCodeToByte (Call a) = + B.pack [fromIntegral (opCodeByte (Call a)), fromIntegral a] +opCodeToByte (If a) = + B.pack [fromIntegral (opCodeByte (If a)), fromIntegral (ifTypeByte a)] +opCodeToByte op = B.pack [fromIntegral (opCodeByte op)] + +codeSectionCodeToByte :: CodeSectionCode -> B.ByteString +codeSectionCodeToByte (CSC a b lc ld e) = + extendsBytes + (B.pack (map fromIntegral (leb128Encode a))) + [ + [B.pack [fromIntegral b]], + map codeSectionCodeLocalsToByte lc, + map opCodeToByte ld, + [B.pack [fromIntegral e]] + ] + +codeSectionToByte :: CodeSection -> B.ByteString +codeSectionToByte (CS a b c ld) = + extendsBytes + (B.pack [fromIntegral a]) + [ + [B.pack (map fromIntegral (leb128Encode b))], + [B.pack [fromIntegral c]], + map (codeSectionCodeToByte) ld + ] + +wasmToByteString :: Wasm -> B.ByteString +wasmToByteString (Wasm hW vW tS fS mS eS cS) = + extendBytes + (headerWasmToByteString (Wasm hW vW tS fS mS eS cS)) + [ + typeSectionToByteString tS, + functionSectionToByteString fS, + memorySectionToByteString mS, + exportSectionToByteString eS, + codeSectionToByte cS + ] + +writeWasm :: Wasm -> FilePath -> IO () +writeWasm w f = B.writeFile f bytes + where + bytes = wasmToByteString w diff --git a/lvtc/stack.yaml b/lvtc/stack.yaml index b2997b7..cabf00c 100644 --- a/lvtc/stack.yaml +++ b/lvtc/stack.yaml @@ -40,7 +40,18 @@ packages: # - git: https://github.com/commercialhaskell/stack.git # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a # -# extra-deps: [] +extra-deps: +- tasty-1.4.2.2 +- tasty-hunit-0.10.1 +- bytestring-0.12.0.2 +- unix-2.8.5.0 +- process-1.6.18.0 +- text-2.1 +- binary-0.8.9.1 +- directory-1.3.8.2 +- filepath-1.4.100.4 +- Win32-2.13.4.0 +- time-1.12.2 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/lvtc/stack.yaml.lock b/lvtc/stack.yaml.lock index a39a124..0ee44a8 100644 --- a/lvtc/stack.yaml.lock +++ b/lvtc/stack.yaml.lock @@ -3,7 +3,84 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: [] +packages: +- completed: + hackage: tasty-1.4.2.2@sha256:b987609178d70c0042b950302161a049be8a878aa8cee4a9c7ba81d22d29a3f5,2719 + pantry-tree: + sha256: a93f5e31aac66a82a885cb2ddc8eada9a8adefe8587da1c4085fae58b6bc4683 + size: 1944 + original: + hackage: tasty-1.4.2.2 +- completed: + hackage: tasty-hunit-0.10.1@sha256:ebc17b490750d4796b21d44001b852688cc39f9c34e387d5e7958e09b9b3f3b9,1602 + pantry-tree: + sha256: c00ed23d8281b6c6f4ec33dd1e9e3a7971b0a769b6140978cfaf2a6eff025c78 + size: 399 + original: + hackage: tasty-hunit-0.10.1 +- completed: + hackage: bytestring-0.12.0.2@sha256:9fc077ff5b7ed2246773c3ac4370ef8822e4834d4587522b68ae551a5968fb86,7891 + pantry-tree: + sha256: 05b5b3ef529f137062c632c38d9c94482ee25bcc0438d51a4be5448dafe690c9 + size: 4355 + original: + hackage: bytestring-0.12.0.2 +- completed: + hackage: unix-2.8.5.0@sha256:633f15ef0bd50a16a7b5c5e86e6659fee6e4e211e098cc8bd0029f452bfcfddc,9808 + pantry-tree: + sha256: d02b6227c6717f58c6f6ef1923f70af11b1a88987917010c3819c433344f4e3a + size: 5821 + original: + hackage: unix-2.8.5.0 +- completed: + hackage: process-1.6.18.0@sha256:69fbbca4151e1a6d1a5da41a1e17c254871675a4f2aed5213bbdfb10b5e52742,3148 + pantry-tree: + sha256: cd0bf20226dad3e1a1cfee36d38c3f74e851c3d1418d41d8cd3fb656d4f16634 + size: 1675 + original: + hackage: process-1.6.18.0 +- completed: + hackage: text-2.1@sha256:471b9a22f88b1d51bc343e7d1db7bf88b84e1582eb6d5fbe643fe7afc683c256,9422 + pantry-tree: + sha256: eeaf5496ca61f2c7823c2c851b6841203a854166b2a1d458fb8f302b7bcc6092 + size: 7878 + original: + hackage: text-2.1 +- completed: + hackage: binary-0.8.9.1@sha256:81f468c1c75fd6535152ab69b2d32ac6cfcc03e345267b069abe4da56ec95801,6523 + pantry-tree: + sha256: 956ecd662408f69615977b87a92e042abcdc447b7824b8aabf5788c4393c10c5 + size: 1976 + original: + hackage: binary-0.8.9.1 +- completed: + hackage: directory-1.3.8.2@sha256:aa62af76daa1ed082933561a98ae342d4c3ef24bcca7197376ef605fee7d0949,3150 + pantry-tree: + sha256: 80e22e8d8bccbc6a9b26bd4a153550c2c8e3739d5a77efe0633e3e1bd2f18a60 + size: 3519 + original: + hackage: directory-1.3.8.2 +- completed: + hackage: filepath-1.4.100.4@sha256:2de84756d3907308230e34fcc7c1917a73f218f6d53838618b7d5b95dd33e2c3,5536 + pantry-tree: + sha256: 3f8869f574ea76933efe77ed3c6e4e5a646317b38e8962970c8d0d092266f230 + size: 3346 + original: + hackage: filepath-1.4.100.4 +- completed: + hackage: Win32-2.13.4.0@sha256:6a1299d051c514aa5ac7b77ef5f86be6c0aa6940b00302c6dc246192c7a97d99,5769 + pantry-tree: + sha256: d9d803aee91429f95e4de4795fc41451765761f73df5c009edd7333e2f3a49a1 + size: 8011 + original: + hackage: Win32-2.13.4.0 +- completed: + hackage: time-1.12.2@sha256:88e8493d9130038d3b9968a2530a0900141cd3d938483c83dde56e12b875ebc8,6510 + pantry-tree: + sha256: de0ab314661da3788b5dad20254e44929b1659b00d32b5a0cd54922a05e006e8 + size: 7264 + original: + hackage: time-1.12.2 snapshots: - completed: sha256: e176944bc843f740e05242fa7a66ca1f440c127e425254f7f1257f9b19add23f diff --git a/lvtc/test/Spec.hs b/lvtc/test/Spec.hs index c8cabca..9e5229b 100644 --- a/lvtc/test/Spec.hs +++ b/lvtc/test/Spec.hs @@ -5,5 +5,177 @@ -- Tests -} +import Test.Tasty +import Test.Tasty.HUnit + +import Expression +import Parser +import Alias + +import UTParseLvt +import UTShuntingYard +import UTWatLike +import UTWat +import UTWasm +import UTLexeme + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Leviator Tests - Compiler" + [ + utParserExpression, + utParserExpressions, + utParserLvt, + utShuntingYard, + utAlias, + utWatLike, + utWat, + utWasm, + utLexeme + ] + +testParserHelper :: String -> String -> Expression -> IO () +testParserHelper str restExpected expressionExpected = + case runParser parseExpresion str of + Just (parsed, rest) -> assertEqual str restExpected rest >> + assertEqual str expressionExpected parsed + Nothing -> assertFailure ("Parsing failed for: `" ++ str ++ "`") + +testParserHelperFail :: String -> IO () +testParserHelperFail str = case runParser parseExpresion str of + Just _ -> assertFailure ("Parsing should have failed: " ++ str) + Nothing -> assertEqual str "" "" + +utParserExpression :: TestTree +utParserExpression = testGroup "Parse Expression" + [ +-- function + testCase "function main" $ + testParserHelper + "fn main() -> Int \n{\n <- 0;\n};\n" + "" + (Function "fn main() -> Int \n{\n <- 0;\n};\n") + , testCase "function bad formated (no end `}`)" $ + testParserHelperFail + "fn main() -> Int \n{\n <- 0;\n" + , testCase "function bad formated (no end `;`)" $ + testParserHelperFail + "fn main() -> Int \n{\n <- 0;\n}\n" + , testCase "function bad formated (no end `\\n`)" $ + testParserHelperFail + "fn main() -> Int \n{\n <- 0;\n};" + , testCase "function export" $ + testParserHelper + "export fn main() -> Int \n{\n <- 0;\n};\n" + "" + (Function "export fn main() -> Int \n{\n <- 0;\n};\n") +-- alias + , testCase "alias" $ + testParserHelper + "alias abc def;\n" + "" + (Expression.Alias "alias abc def;\n") + , testCase "alias bad formated (no end `\\n`)" $ + testParserHelperFail + "alias abc def;" + , testCase "alias bad formated (no end `;`)" $ + testParserHelperFail + "alias abc def\n" +-- comment + , testCase "comment" $ + testParserHelper + "// this is a comment\n" + "" + (Comment "// this is a comment\n") + , testCase "comment bad formated (no end `\\n`)" $ + testParserHelperFail + "// this is a comment" +-- bad formated + , testCase "bad formated" $ + testParserHelperFail + "abc" + , testCase "bad formated 2" $ + testParserHelperFail + "/ def;\n" + , testCase "bad formated 3" $ + testParserHelperFail + "def;\n" + , testCase "bad formated 4" $ + testParserHelperFail + "export abc()" + ] + + +testParserHelpers :: String -> String -> [Expression] -> IO () +testParserHelpers str restExpected expressionExpected = + case runParser parseAllExpression str of + Just (parsed, rest) -> assertEqual str restExpected rest >> + assertEqual str expressionExpected parsed + Nothing -> assertFailure ("Parsing failed: " ++ str) + +testParserHelperFails :: String -> IO () +testParserHelperFails str = case runParser parseAllExpression str of + Just (x, _) -> assertFailure ("Parsing should have failed: `" ++ str ++ "` But got: `" ++ show x ++ "`") + Nothing -> assertEqual str "" "" + +utParserExpressions :: TestTree +utParserExpressions = testGroup "Parse Expressions" + [ +-- function + testCase "function main" $ + testParserHelpers + "fn main() -> Int \n{\n <- 0;\n};\nexport fn main() -> Int \n{\n <- 0;\n};\n" + "" + [Function "fn main() -> Int \n{\n <- 0;\n};\n", Function "export fn main() -> Int \n{\n <- 0;\n};\n"] + , testCase "function bad formated (no end `}`)" $ + testParserHelperFails + "fn main() -> Int \n{\n <- 0;\n};\nfn main() -> Int \n{\n <- 0;\n" + , testCase "function bad formated (no end `;`)" $ + testParserHelperFails + "fn main() -> Int \n{\n <- 0;\n}\nfn main() -> Int \n{\n <- 0;\n};\n" +-- alias + , testCase "alias" $ + testParserHelpers + "alias abc def;\nalias def def;\n" + "" + [Expression.Alias "alias abc def;\n", Expression.Alias "alias def def;\n"] + , testCase "alias multiline" $ + testParserHelpers + "alias abc def\nefg hij;\n" + "" + [Expression.Alias "alias abc def\nefg hij;\n"] +-- comment + , testCase "comment" $ + testParserHelpers + "// this is a comment\nalias abc def;\n" + "" + [Comment "// this is a comment\n", Expression.Alias "alias abc def;\n"] + ] + +utAlias :: TestTree +utAlias = testGroup "Alias" + [ + testCase "alias" $ + assertEqual "alias" + [ + Expression.Function "fn main() -> Int \n{\n <- 0;\n};" + ] + (proceedAlias [ + Expression.Alias "alias int Int;\n", + Expression.Alias "alias retValue 0;\n", + Expression.Function "fn main() -> int \n{\n <- retValue;\n};" + ]) + , testCase "nested alias" $ + assertEqual "alias nested" + [ + Expression.Function "fn main() -> Int \n{\n <- 0;\n};" + ] + (proceedAlias [ + Expression.Alias "alias int INT;\n", + Expression.Alias "alias retValue 0;\n", + Expression.Alias "alias INT Int;\n", + Expression.Function "fn main() -> int \n{\n <- retValue;\n};" + ]) + ] diff --git a/lvtc/test/UTLexeme.hs b/lvtc/test/UTLexeme.hs new file mode 100644 index 0000000..32ff876 --- /dev/null +++ b/lvtc/test/UTLexeme.hs @@ -0,0 +1,58 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- UTLexeme +-} + +module UTLexeme +( + utLexeme +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Lexeme + +utLexeme :: TestTree +utLexeme = testGroup "UTLexeme" + [ + testCase "lexeme1" $ + assertEqual "1" + l1_rep + (lexeme1 l1) + , testCase "lexeme2" $ + assertEqual "2" + l2_rep + (lexeme1 l2) + , testCase "lexeme3" $ + assertEqual "3" + l3_rep + (lexeme1 l3) + , testCase "lexeme4" $ + assertEqual "4" + l4_rep + (lexeme1 l4) + , testCase "lexeme5" $ + assertEqual "5" + l5_rep + (lexeme1 l5) + , testCase "lexeme6" $ + assertEqual "6" + l6_rep + (lexeme1 l6) + ] + where + l1 = "@Int a = 0;" + l1_rep = "@Int a=0;" + l2 = "if (a > b) {\n do(b);\n}\n" + l2_rep = "if(a>b){do(b);}" + l3 = "if (a)\n{\nb(0);\n}\nelse\n{\nc(0);\n};\n" + l3_rep = "if(a){b(0);}else{c(0);};" + l4 = "@Int a = 0;\n @Int c = b(a);\n if (c)\n {\n d(a);\n };\n" + l4_rep = "@Int a=0;@Int c=b(a);if(c){d(a);};" + l5 = "foo(a);\n foo(b);\n" + l5_rep = "foo(a);foo(b);" + l6 = "export fn start() -> Int\n{\n @Int one = 15;\n @Int two = 5;\n three = 0;\n if (one == 5)\n {\n three = 15;\n };\n if (two == 5)\n{\n three = 5;\n };\n <- three;\n};\n" + l6_rep = "export fn start()->Int{@Int one=15;@Int two=5;three=0;if(one==5){three=15;};if(two==5){three=5;};<-three;};" diff --git a/lvtc/test/UTParseLvt.hs b/lvtc/test/UTParseLvt.hs new file mode 100644 index 0000000..d0cf211 --- /dev/null +++ b/lvtc/test/UTParseLvt.hs @@ -0,0 +1,131 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- UTParseLvt +-} + +module UTParseLvt ( + utParserLvt +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Parser +import ParseLvt +import Lexeme +import AST + +testParserHelper :: String -> String -> Instruction -> IO () +testParserHelper str restExpected expressionExpected = + case runParser parseInstruction (lexeme1 str) of + Just (parsed, rest) -> assertEqual str restExpected rest >> + assertEqual str expressionExpected parsed + Nothing -> assertFailure ("Parsing failed for: `" ++ str ++ "`") + +testParserFunc :: String -> String -> FuncDeclaration -> IO () +testParserFunc str restExpected expressionExpected = + case runParser parseFuncDeclaration (lexeme1 str) of + Just (parsed, rest) -> assertEqual str restExpected rest >> + assertEqual str expressionExpected parsed + Nothing -> assertFailure ("Parsing failed for: `" ++ str ++ "`") + +testParserHelpers :: String -> String -> [Instruction] -> IO () +testParserHelpers str restExpected expressionExpected = + case runParser parseInstructions (lexeme1 str) of + Just (parsed, rest) -> assertEqual str restExpected rest >> + assertEqual str expressionExpected parsed + Nothing -> assertFailure ("Parsing failed for: `" ++ str ++ "`") + +utParserLvt :: TestTree +utParserLvt = testGroup "Parse Lvt" + [ + testCase "declare int" $ + testParserHelper "@Int a = 0;\n" + "" + (Declaration (("a", "Int"), Integer 0)) + , testCase "declare bool" $ + testParserHelper "@Bool a = True;\n" + "" + (Declaration (("a", "Bool"), Boolean True)) + , testCase "declare string view" $ + testParserHelper "@StringView a = \"abc\";\n" + "" + (Declaration (("a", "StringView"), StringView "abc")) + , testCase "declare character" $ + testParserHelper "@Char a = 'a';\n" + "" + (Declaration (("a", "Char"), Character 'a')) + , testCase "assign variable" $ + testParserHelper "a = 0;\n" + "" + (Assignation ("a", Integer 0)) + , testCase "call function" $ + testParserHelper "a(0);\n" + "" + (Function ("a", [Integer 0])) + , testCase "call function (no arguments)" $ + testParserHelper "a();\n" + "" + (Function ("a", [])) + , testCase "call function (3 arguments)" $ + testParserHelper "a(0, \"abc\", False);\n" + "" + (Function ("a", [Integer 0, StringView "abc", Boolean False])) + , testCase "return value" $ + testParserHelpers "<- 0;\n" + "" + [(Return (Integer 0))] + , testCase "condition if" $ + testParserHelper "if (a)\n{\nb(0);\n};\n" + "" + (Cond (Var "a", [Function ("b", [Integer 0])], [])) + , testCase "condition if else" $ + testParserHelper "if (a)\n{\nb(0);\n}\nelse\n{\nc(0);\n};\n" + "" + (Cond (Var "a", [Function ("b", [Integer 0])], [Function ("c", [Integer 0])])) + , testCase "condition if with indent" $ + testParserHelper "if (a)\n{\n b(0);\n};\n" + "" + (Cond (Var "a", [Function ("b", [Integer 0])], [])) + , testCase "condition if else with indent" $ + testParserHelper "if (a)\n{\n b(0);\n}\nelse\n{\n c(0);\n};\n" + "" + (Cond (Var "a", [Function ("b", [Integer 0])], [Function ("c", [Integer 0])])) + , testCase "test multiple instruction" $ + testParserHelpers "@Int a = 0;\n @Int c = b(a);\n if (c)\n {\n d(a);\n };\n" + "" + [ + Declaration (("a", "Int"), Integer 0), + Declaration (("c", "Int"), FuncValue ("b", [Var "a"])), + Cond (Var "c", [Function ("d", [Var "a"])], []) + ] + , testCase "test func" $ + testParserFunc "fn abc(a: Int) -> Int\n{\n <- a;\n};\n" + "" + ( + (False, "abc", [("a", "Int")], "Int"), + [ + Return (Var "a") + ] + ) + , testCase "test func export" $ + testParserFunc "export fn abc(a: Int) -> Int\n{\n <- a;\n};\n" + "" + ( + (True, "abc", [("a", "Int")], "Int"), + [ + Return (Var "a") + ] + ) + , testCase "test func start" $ + testParserFunc "export fn start() -> Int\n{\n <- 0;\n};\n" + "" + ( + (True, "start", [], "Int"), + [ + Return (Integer 0) + ] + ) + ] diff --git a/lvtc/test/UTShuntingYard.hs b/lvtc/test/UTShuntingYard.hs new file mode 100644 index 0000000..3af9324 --- /dev/null +++ b/lvtc/test/UTShuntingYard.hs @@ -0,0 +1,80 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- UTShuntingYard +-} + +module UTShuntingYard ( + utShuntingYard +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import ShuntingYard +import AST + +utShuntingYard :: TestTree +utShuntingYard = testGroup "ShuntingYard" + [ + testCase "basic" $ + assertEqual "3+5" + (SYS [] [Integer 3, Integer 5, Var "+"]) + basic_end + , testCase "basic basic" $ + assertEqual "3+4+5" + (SYS [] [Integer 3, Integer 4, Var "+", Integer 5, Var "+"]) + basic_basic_end + , testCase "priority *" $ + assertEqual "3+4*5" + (SYS [] [Integer 3, Integer 4, Integer 5, Var "*", Var "+"]) + priority_mul_end + , testCase "priority /" $ + assertEqual "3-4/5" + (SYS [] [Integer 3, Integer 4, Integer 5, Var "/", Var "-"]) + priority_div_end + , testCase "3+4*2/{1-5}" $ + assertEqual "3+4*2/{1-5}" + (SYS [] [Integer 3, Integer 4, Integer 2, Var "*", Integer 1, Integer 5, Var "-", Var "/", Var "+"]) + priority_end + ] + where + basic_1 = shuntingYardValue (Integer 3) (SYS [] []) + basic_2 = shuntingYardOp (Var "+") basic_1 + basic_3 = shuntingYardValue (Integer 5) basic_2 + basic_end = shuntingYardEnd basic_3 + -- + basic_basic_1 = shuntingYardValue (Integer 3) (SYS [] []) + basic_basic_2 = shuntingYardOp (Var "+") basic_basic_1 + basic_basic_3 = shuntingYardValue (Integer 4) basic_basic_2 + basic_basic_4 = shuntingYardOp (Var "+") basic_basic_3 + basic_basic_5 = shuntingYardValue (Integer 5) basic_basic_4 + basic_basic_end = shuntingYardEnd basic_basic_5 + -- + priority_mul_1 = shuntingYardValue (Integer 3) (SYS [] []) + priority_mul_2 = shuntingYardOp (Var "+") priority_mul_1 + priority_mul_3 = shuntingYardValue (Integer 4) priority_mul_2 + priority_mul_4 = shuntingYardOp (Var "*") priority_mul_3 + priority_mul_5 = shuntingYardValue (Integer 5) priority_mul_4 + priority_mul_end = shuntingYardEnd priority_mul_5 + -- + priority_div_1 = shuntingYardValue (Integer 3) (SYS [] []) + priority_div_2 = shuntingYardOp (Var "-") priority_div_1 + priority_div_3 = shuntingYardValue (Integer 4) priority_div_2 + priority_div_4 = shuntingYardOp (Var "/") priority_div_3 + priority_div_5 = shuntingYardValue (Integer 5) priority_div_4 + priority_div_end = shuntingYardEnd priority_div_5 + -- + priority_1 = shuntingYardValue (Integer 3) (SYS [] []) + priority_2 = shuntingYardOp (Var "+") priority_1 + priority_3 = shuntingYardValue (Integer 4) priority_2 + priority_4 = shuntingYardOp (Var "*") priority_3 + priority_5 = shuntingYardValue (Integer 2) priority_4 + priority_6 = shuntingYardOp (Var "/") priority_5 + priority_7 = shuntingYardOp (Var "{") priority_6 + priority_8 = shuntingYardValue (Integer 1) priority_7 + priority_9 = shuntingYardOp (Var "-") priority_8 + priority_10 = shuntingYardValue (Integer 5) priority_9 + priority_11 = shuntingYardOp (Var "}") priority_10 + priority_end = shuntingYardEnd priority_11 diff --git a/lvtc/test/UTWasm.hs b/lvtc/test/UTWasm.hs new file mode 100644 index 0000000..cc7cd12 --- /dev/null +++ b/lvtc/test/UTWasm.hs @@ -0,0 +1,199 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- UTWasm +-} + +module UTWasm +( + utWasm +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Builtins +import Wasm +import WatAST +import WatToWasm + +basic1Rep :: Wasm +basic1Rep = + Wasm { + headerWasm = (0,97,115,109), + versionWasm = (1,0,0,0), + typeSection = TS { + headerTS = 1, + sizeTS = 11, + nbTypes = 2, + types = [ + Func { + headerFunc = 96, + nbParams = 2, + params = [Wasm.I32,Wasm.I32], + nbResults = 1, + results = [Wasm.I32] + }, + Func { + headerFunc = 96, + nbParams = 0, + params = [], + nbResults = 1, + results = [Wasm.I32] + } + ] + }, + functionSection = FS { + headerFS = 3, + sizeFS = 12, + nbFuncs = 11, + funcs = [ + 0,0,0,0,0,0,0,0,0,0,1 + ] + }, + memorySection = MS { + headerMS = 5, + sizeMS = 3, + nbLimits = 1, + limits = [ + MSL { + hasMax = 0, + minMS = 1, + maxMS = 0 + } + ] + }, + exportSection = ES { + headerES = 7, + sizeES = 1, + nbExports = 0, + exports = [] + }, + codeSection = CS { + headerCS = 10, + sizeCS = 103, + nbCodes = 11, + codes = [ + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32Add,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32Sub,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32Mul,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32Div,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32EQ,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32LT_S,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0 , + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32GT_S,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32LE_S,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1, I32GE_S,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 8, + nbLocals = 0, + locals = [], + bodyCSC = [ + LocalGet 0,LocalGet 1,I32NE,Return + ], + endCSC = 11 + }, + CSC { + sizeCSC = 11, + nbLocals = 1, + locals = [(1,Wasm.I32)], + bodyCSC = [ + I32Const 97,LocalSet 0,LocalGet 0,Return + ], + endCSC = 11 + } + ] + } + } + +utWasm :: TestTree +utWasm = testGroup "Wasm" + [ + testCase "basic" $ + assertEqual "Basic" + basic1Rep + (watToWasm basic1) + ] + where + basic1 = + getBuiltinsWat ++ + [ + FuncDef False "add" 10 [] WatAST.I32 [ + I32Const 97, + LocalSet 0, + LocalGet 0, + Return + ] [(WatAST.I32, 1)] + ] diff --git a/lvtc/test/UTWat.hs b/lvtc/test/UTWat.hs new file mode 100644 index 0000000..865267e --- /dev/null +++ b/lvtc/test/UTWat.hs @@ -0,0 +1,111 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- UTWatLike +-} + +module UTWat +( + utWat +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import WatAST +import AST +import WatLikeToWat +import Builtins +import UTWatLike + +utWat :: TestTree +utWat = testGroup "Wat" + [ + testCase "basic" $ + assertEqual "Basic" + basic1_rep + (watsLikeToWat basic1) + , testCase "basic2" $ + assertEqual "Basic2" + basic2_rep + (watsLikeToWat basic2) + ] + where + basic1 = + builtinsWatLike ++ + [ + ( + ( + (False, "10", [], "Int"), + [ + Declaration (("0", "Int"), Integer 97), + AST.Return (Var "0") + ] + ), + [(0, "_tmpValue")], + "add" + ) + ] + basic1_rep = + getBuiltinsWat ++ + [ + FuncDef False "add" 10 [] I32 [ + I32Const 97, + LocalSet 0, + LocalGet 0, + WatAST.Return + ] [(I32, 1)] + ] + basic2 = + builtinsWatLike ++ + [ + ( + ( + (False, "10", [("0", "Int"), ("1", "Int")], "Int"), + [ + Declaration (("2", "Int"), FuncValue ("0", [Var "0", Var "1"])), + AST.Return (Var "2") + ] + ), + [(0, "a"), (1, "b"), (2, "_tmpValue")], + "add" + ), + ( + ( + (False, "11", [], "Int"), + [ + Declaration (("0", "Int"), Integer 1), + Declaration (("1", "Int"), Integer 2), + Declaration (("2", "Int"), FuncValue ("10", [Var "0", Var "1"])), + AST.Return (Var "2") + ] + ), + [(0, "_tmpValue"), (1, "_tmpValue"), (2, "_tmpValue")], + "start" + ) + ] + basic2_rep = + getBuiltinsWat ++ + [ + FuncDef False "add" 10 [I32, I32] I32 [ + LocalGet 0, + LocalGet 1, + Call 0, + LocalSet 2, + LocalGet 2, + WatAST.Return + ] [(I32, 1)], + FuncDef False "start" 11 [] I32 [ + I32Const 1, + LocalSet 0, + I32Const 2, + LocalSet 1, + LocalGet 0, + LocalGet 1, + Call 10, + LocalSet 2, + LocalGet 2, + WatAST.Return + ] [(I32, 3)] + ] diff --git a/lvtc/test/UTWatLike.hs b/lvtc/test/UTWatLike.hs new file mode 100644 index 0000000..0211800 --- /dev/null +++ b/lvtc/test/UTWatLike.hs @@ -0,0 +1,152 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- UTWatLike +-} + +module UTWatLike ( + utWatLike + , builtinsWatLike +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import WatLike +import AST + +builtinsWatLike :: [FuncDeclare] +builtinsWatLike = + [ + ( + ((False, "0", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "+" + ), + ( + ((False, "1", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "-" + ), + ( + ((False, "2", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "*" + ), + ( + ((False, "3", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "/" + ), + ( + ((False, "4", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "==" + ), + ( + ((False, "5", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "<" + ), + ( + ((False, "6", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], ">" + ), + ( + ((False, "7", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "<=" + ), + ( + ((False, "8", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], ">=" + ), + ( + ((False, "9", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")], "!=" + ) + ] + +utWatLike :: TestTree +utWatLike = testGroup "Wat Like" + [ + testCase "basic" $ + assertEqual "Basic" + basic1_rep + (aSTToWatLike [basic1]) + , testCase "basic basic" $ + assertEqual "Basic Basic" + basic2_rep + (aSTToWatLike basic2) + , testCase "basic basic basic" $ + assertEqual "Basic Basic Basic" + basic3_rep + (aSTToWatLike [basic3]) + ] + where + basic1 = + ( + (False, "add", [("a", "Int"), ("b", "Int")], "Int"), + [Return (FuncValue ("+", [Var "a", Var "b"]))] + ) + basic1_rep = + builtinsWatLike ++ [ + ( + ( + (False, "10", [("0", "Int"), ("1", "Int")], "Int"), + [ + Declaration (("2", "Int"), FuncValue ("0", [Var "0", Var "1"])), + Return (Var "2") + ] + ), + [(0, "a"), (1, "b"), (2, "_tmpValue")], "add" + ) + ] + basic2 = + [ + ( + (False, "add", [("a", "Int"), ("b", "Int")], "Int"), + [Return (FuncValue ("+", [Var "a", Var "b"]))] + ), + ( + (False, "start", [], "Int"), + [Return (FuncValue ("add", [Integer 1, Integer 2]))] + ) + ] + basic2_rep = + builtinsWatLike ++ [ + ( + ( + (False, "10", [("0", "Int"), ("1", "Int")], "Int"), + [ + Declaration (("2", "Int"), FuncValue ("0", [Var "0", Var "1"])), + Return (Var "2") + ] + ), + [(0, "a"), (1, "b"), (2, "_tmpValue")], "add" + ), + ( + ( + (False, "11", [], "Int"), + [ + Declaration (("0", "Int"), Integer 1), + Declaration (("1", "Int"), Integer 2), + Declaration (("2", "Int"), FuncValue ("10", [Var "0", Var "1"])), + Return (Var "2") + ] + ), + [(0, "_tmpValue"), (1, "_tmpValue"), (2, "_tmpValue")], "start" + ) + ] + basic3 = + ( + (False, "getC", [], "Char"), + [Return (Character 'a')] + ) + basic3_rep = + builtinsWatLike ++ [ + ( + ( + (False, "10", [], "Int"), + [ + Declaration (("0", "Int"), Integer 97), + Return (Var "0") + ] + ), + [(0, "_tmpValue")], "getC" + ) + ] diff --git a/lvtc/test/lvt/Test.lvt b/lvtc/test/lvt/Test.lvt new file mode 100644 index 0000000..cb0a607 --- /dev/null +++ b/lvtc/test/lvt/Test.lvt @@ -0,0 +1,14 @@ +fn factorial(n: Int) -> Int +{ + @Int a = n - 1; + if (a == 0) + { + <- 1; + }; + <- n * factorial(a); +}; + +export fn start() -> Int +{ + <- factorial(5); +}; diff --git a/lvtext/vscode/leviator-lang/.vscode/launch.json b/lvtext/vscode/leviator-lang/.vscode/launch.json new file mode 100644 index 0000000..e64ce7a --- /dev/null +++ b/lvtext/vscode/leviator-lang/.vscode/launch.json @@ -0,0 +1,17 @@ +// A launch configuration that launches the extension inside a new window +// Use IntelliSense to learn about possible attributes. +// Hover to view descriptions of existing attributes. +// For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 +{ + "version": "0.2.0", + "configurations": [ + { + "name": "Extension", + "type": "extensionHost", + "request": "launch", + "args": [ + "--extensionDevelopmentPath=${workspaceFolder}" + ] + } + ] +} diff --git a/lvtext/vscode/leviator-lang/.vscodeignore b/lvtext/vscode/leviator-lang/.vscodeignore new file mode 100644 index 0000000..19bbe78 --- /dev/null +++ b/lvtext/vscode/leviator-lang/.vscodeignore @@ -0,0 +1,3 @@ +.vscode/** +.vscode-test/** +.gitignore diff --git a/lvtext/vscode/leviator-lang/README.md b/lvtext/vscode/leviator-lang/README.md new file mode 100644 index 0000000..226e7d9 --- /dev/null +++ b/lvtext/vscode/leviator-lang/README.md @@ -0,0 +1,13 @@ +## About + +Extension to enable syntax highlighting for [Leviator](https://github.com/X-R-G-B/Leviator) in [Visual Studio Code](https://code.visualstudio.com/). + +## Installation + +1. Find your vscode extension directory (default: `~/.vscode/extensions`) +2. Copy or move the "./lvtext/vscode/leviator-lang" directory into the vscode extension directory +3. Reload vscode + +## Usage + +Open a Leviator file (`.lvt`) and enjoy the syntax highlighting. diff --git a/lvtext/vscode/leviator-lang/assets/icon.png b/lvtext/vscode/leviator-lang/assets/icon.png new file mode 100644 index 0000000..7eba1c1 Binary files /dev/null and b/lvtext/vscode/leviator-lang/assets/icon.png differ diff --git a/lvtext/vscode/leviator-lang/language-configuration.json b/lvtext/vscode/leviator-lang/language-configuration.json new file mode 100644 index 0000000..9da1356 --- /dev/null +++ b/lvtext/vscode/leviator-lang/language-configuration.json @@ -0,0 +1,28 @@ +{ + "comments": { + // symbol used for single line comment. Remove this entry if your language does not support line comments + "lineComment": "//" + }, + // symbols used as brackets + "brackets": [ + ["{", "}"], + ["[", "]"], + ["(", ")"] + ], + // symbols that are auto closed when typing + "autoClosingPairs": [ + ["{", "}"], + ["[", "]"], + ["(", ")"], + ["\"", "\""], + ["'", "'"] + ], + // symbols that can be used to surround a selection + "surroundingPairs": [ + ["{", "}"], + ["[", "]"], + ["(", ")"], + ["\"", "\""], + ["'", "'"] + ] +} diff --git a/lvtext/vscode/leviator-lang/package.json b/lvtext/vscode/leviator-lang/package.json new file mode 100644 index 0000000..c7c4d63 --- /dev/null +++ b/lvtext/vscode/leviator-lang/package.json @@ -0,0 +1,41 @@ +{ + "name": "leviator-lang", + "displayName": "Leviator Lang", + "version": "0.0.1", + "description": "Syntax highlighting for leviator lang", + "author": { + "name": "GTX", + "url": "https://github.com/X-R-G-B" + }, + "icon": "assets/icon.png", + "engines": { + "vscode": "^1.85.0" + }, + "publisher": "X-L-R-G-B", + "categories": [ + "Programming Languages" + ], + "pricing": "Free", + "license": "MIT", + "repository": { + "type": "git", + "url": "https://github.com/X-R-G-B/Leviator" + }, + "bugs": { + "url": "https://github.com/X-R-G-B/Leviator/issues" + }, + "homepage": "https://github.com/X-R-G-B/Leviator/blob/main/README.md", + "contributes": { + "languages": [{ + "id": "leviator", + "aliases": ["Leviator", "leviator"], + "extensions": [".lvt"], + "configuration": "./language-configuration.json" + }], + "grammars": [{ + "language": "leviator", + "scopeName": "source.lvt", + "path": "./syntaxes/leviator.tmLanguage.json" + }] + } +} diff --git a/lvtext/vscode/leviator-lang/syntaxes/leviator.tmLanguage.json b/lvtext/vscode/leviator-lang/syntaxes/leviator.tmLanguage.json new file mode 100644 index 0000000..b2200fa --- /dev/null +++ b/lvtext/vscode/leviator-lang/syntaxes/leviator.tmLanguage.json @@ -0,0 +1,112 @@ +{ + "$schema": "https://raw.githubusercontent.com/martinring/tmlanguage/master/tmlanguage.json", + "name": "Leviator", + "patterns": [ + { + "include": "#keywords" + }, + { + "include": "#string" + }, + { + "include": "#storage" + }, + { + "include": "#constant" + }, + { + "include": "#entity" + }, + { + "include": "#variable" + }, + { + "include": "#comment" + } + ], + "repository": { + "keywords": { + "patterns": [ + { + "name": "keyword.control.leviator", + "match": "\\b(if|else|while|foreach|break)\\b" + }, + { + "name": "keyword.other.leviator", + "match": "(<-|->)" + }, + { + "name": "keyword.operator.leviator", + "match": "(\\+|-|%|\\*|!=|==|<|>|<=|>=|=|/(?!/))" + } + ] + }, + "storage": { + "patterns": [ + { + "name": "storage.type.leviator", + "match": "\\b(struct|fn|Int|Char|Float|Bool|Void|StringView)\\b" + } + ] + }, + "entity": { + "patterns": [ + { + "name": "entity.name.tag.leviator", + "match": "\\b(start)\\b" + }, + { + "name": "entity.name.function", + "match": "\\b([a-zA-Z_][a-zA-Z0-9_]*)\\b\\(" + } + ] + }, + "constant": { + "patterns": [ + { + "name": "constant.language.leviator", + "match": "\\b(True|False)\\b" + }, + { + "name": "constant.numeric.leviator", + "match": "\\b([0-9]+)\\b" + } + ] + }, + "string": { + "patterns": [ + { + "name": "string.quoted.double.leviator", + "begin": "\"", + "end": "\"" + }, + { + "name": "string.quoted.single.leviator", + "begin": "'", + "end": "'" + } + ] + }, + "variable": { + "patterns": [ + { + "name": "variable.other.leviator", + "match": "\\b([a-zA-Z_][a-zA-Z0-9_]*)\\b" + }, + { + "name": "variable.parameter", + "match": "@" + } + ] + }, + "comment": { + "patterns": [ + { + "name": "comment.line.double-slash.leviator", + "match": "//.*" + } + ] + } + }, + "scopeName": "source.lvt" +} diff --git a/lvtext/vscode/leviator-lang/test.lvt b/lvtext/vscode/leviator-lang/test.lvt new file mode 100644 index 0000000..881031b --- /dev/null +++ b/lvtext/vscode/leviator-lang/test.lvt @@ -0,0 +1,64 @@ +// Types +@Int a = 1; +@Char b = 'a'; +@Float c = 1.0; +@Bool d = true; +@StringView e = "Leviator"; + +// Data types +struct Point +{ + x: Float, + y: Float, +}; + +fn printPoint(p: Point) -> Void +{ + print(p:x); + print(p:y); +}; + +// Functions +fn add(a: Int, b: Int) -> Int +{ + <- a + b; +}; + +// Conditions + flow control +fn max(a: Int, b: Int) -> Int +{ + if (a > b) + { + <- a; + } + else + { + <- b; + }; +}; + +fn hundredPrinter() -> Void +{ + @Int i = 0; + + while (True) + { + // New line every 10 numbers + if (i % 10 == 0) + { + print("\n"); + }; + print(i); + if (i == 100) + { + break; + }; + i = i + 1; + }; +}; + +// Entry point of the program +fn start() +{ + print("Hello, world!\n"); +}; diff --git a/lvtext/webrunner/README.md b/lvtext/webrunner/README.md new file mode 100644 index 0000000..6b137da --- /dev/null +++ b/lvtext/webrunner/README.md @@ -0,0 +1,5 @@ +# WebRunner + +A simple static site that load a wasm and call the `start` exported function. + + diff --git a/lvtext/webrunner/index.html b/lvtext/webrunner/index.html new file mode 100644 index 0000000..1b5252e --- /dev/null +++ b/lvtext/webrunner/index.html @@ -0,0 +1,30 @@ + + Leviator Web Runner + + +

Leviator Web Runner

+ online docs

+ + + +

Output:

+
+ + + diff --git a/lvtrun/Makefile b/lvtrun/Makefile index 474c67b..e15efd5 100644 --- a/lvtrun/Makefile +++ b/lvtrun/Makefile @@ -21,6 +21,9 @@ all: $(TARGET) $(TARGET): stack build --copy-bins --local-bin-path . +debug: + stack build --trace --copy-bins --local-bin-path . + clean: stack clean diff --git a/lvtrun/README.md b/lvtrun/README.md index 163ee90..66f147e 100644 --- a/lvtrun/README.md +++ b/lvtrun/README.md @@ -1 +1,411 @@ # lvtrun + +# ----------------------- 0 ----------------------- + +00 61 73 6d # magic number, always 00 61 73 6d, otherwise the file is invalid +01 00 00 00 # version, always 01 00 00 00, otherwise the file is invalid + +# ----------------------- 1 ----------------------- + +# 01 is the id of the id for type section +01 11 04 +# 11 is the length of the section = 17 in decimal +# 04 is the number of types in the section + +60 00 01 7f +# 60 is the type "function" +# 00 number of parameters +# 01 number of results +# 0x7f is the type "i32" + +60 00 00 +# 0 parameter and 0 result +60 01 7f 00 +# 1 parameter i32 and 0 result +60 01 7f 01 7f +# 1 parameter i32 and 1 result i32 + +(type $t0 (func (result i32))) +(type $t1 (func)) +(type $t2 (func (param i32))) +(type $t3 (func (param i32) (result i32))) + +# ----------------------- 2 ----------------------- + +02 +# 02 is the id of the import section +24 01 16 77 +61 73 69 5f +73 6e 61 70 +73 68 6f 74 +5f 70 72 65 +76 69 65 77 +31 09 70 72 +6f 63 5f 65 +78 69 74 00 +02 + +# ----------------------- 3 ----------------------- + +# section 3 is the function section with 17 bytes of length +# index of the signature (type) of each internal function +# functionsec = section(vec(typeidx)) +03 11 10 +01 +00 +01 +01 +01 +02 +02 +00 +01 +00 +00 +00 +00 +02 +03 +00 + +# ----------------------- 4 ----------------------- the table section + +04 +# 05 = length of the section +05 +# 01 = number of table (its a vector) +01 +# 70 = reftype {can be 70 = funcref or 6f = externref} +70 +# 01 is the indiacator to say "0x00 = min x, max empty or 0x01 = min x, max y" +01 +# 02 is the limit min and max of the table +02 02 + +# ----------------------- 5 ----------------------- the memory section + +05 +06 + +# 01 = number of memory (its a vector) +01 +01 c7 02 c7 02 + +# ----------------------- 6 ----------------------- the global section + +06 12 +# vector of 3 globals +03 +# i32 mut = i32.const 66560 +7f 01 41 c7 c7 04 0b +7f 01 41 00 0b +7f 01 41 00 0b +# (globalType, expr) +# globalType = (valtype, mut) with mut 0x00 = const, 0x01 = var +# expr = (instructions) 0xb + +# ----------------------- 7 ----------------------- + +# export type id +# 00 = function +# 01 = table +# 02 = memory +# 03 = global + + +07 +# 182 bytes of length +b6 +# 010c = 12 exports +01 0c + +# 06 is the length of the name +06 +# 5f 5f 69 6e 64 65 is the name "memory" +6d 65 6d 6f 72 79 +# 02 is export type "memory" +# 00 means export = first vector of memory +02 00 + + +# 19 hex = size in dec = 25 char for the name = __indirect_function +19 +# "_ _ i n d i r e c t _ f u n c t i o n _ t a b l e" +5f 5f 69 6e 64 69 72 65 63 74 5f 66 75 6e 63 74 69 6f 6e 5f 74 61 62 6c 65 +# 01 is export type "table" +01 00 + +# size 6 +06 +# name "start" +5f 73 74 61 72 74 +# its a type function with id 03 +00 03 + +# size = 16 name = __errno_location " +10 +5f 5f 65 72 72 6e 6f 5f 6c 6f 63 61 74 69 6f 6e +# export function of id 8 +00 08 + +# size = 21 name "emcrypten_stack_init" +15 +65 6d 73 63 72 69 70 74 65 6e 5f 73 74 61 63 6b 5f 69 6e 69 74 +# export function of id 9 +00 09 + +# size 25 name = "emscripten_stack_get_free" +19 +65 6d 73 63 72 69 70 74 65 6e 5f 73 74 61 63 6b 5f 67 65 74 5f 66 72 65 65 +# export function of id 10 +00 0a + +# size 25 name = "emcrypten_stack_get_base" +19 65 6d 73 63 72 69 70 74 65 6e 5f 73 74 61 63 6b 5f 67 65 74 5f 62 61 73 65 +# export function of id 11 +00 0b + +# size = "emcrypten_stack_get_end" +18 65 6d 73 63 72 69 70 74 65 6e 5f 73 74 61 63 6b 5f 67 65 74 5f 65 6e 64 +# export function of id 12 +00 0c + +# size = 9 name = "stackSave" +09 73 74 61 63 6b 53 61 76 65 +# export function of id 13 +00 0d + +# size = 12 name = "stackRestore" +0c 73 74 61 63 6b 52 65 73 74 6f 72 65 +# export function of id 14 +00 0e + +# size = 10 name = "stackAlloc" +0a 73 74 61 63 6b 41 6c 6c 6f 63 +# export function of id 15 +00 0f + +# size = 28 name = "emscripten_get_sbrk_ptr" +1c +65 6d 73 63 72 69 70 74 65 6e 5f 73 74 61 63 6b 5f 67 65 74 5f 63 75 72 72 65 6e 74 +# export function of id 16 +00 10 + +# ----------------------- 9 ----------------------- + +09 07 +01 00 41 01 +0b 01 01 + +# ----------------------- 10 ----------------------- + +# refer to: +https://webassembly.github.io/spec/core/binary/instructions.html + +0a +# size = cb = 203 +cb 01 + +# 16 func +10 + +# --- first func --------- + +# first function has a size of 4 +04 +# number of local +00 +# 10 = call +10 09 = call func id 9 +# 0b means end of expression +0b + +# --- second func --------- + +# 25 = length of 37 +25 +# number of local variable of type ( see below ) +01 +# 5 locals variable of type i32 (7f) (because 1 variable local of type x ^) +05 7f +# 23 = global.get = take the index u32 of a symbol in the global section +23 00 +# 21 = local.set = extract top stack value and store it in a local variable +21 00 +# +41 10 = i32.const of value 16 +21 01 = local.set localidx 1 = localvar +20 00 = local.get localidx 0 = localvar +20 01 = local.get localidx 1 = localvar +6b = i32.sub +21 02 = local.set localidx 2 = localvar +41 00 = i32.const of value 0 +21 03 = local.set localidx 3 = localvar +20 02 = local.get localidx 2 = localvar +20 03 = local.get localidx 3 = localvar +36 02 0c = i32.store align 02 offset 0c = 12 +41 00 = i32.const of value 0 +21 04 = local.set localidx 4 = localvar +20 04 = local.get localidx 4 = localvar +0f = return +0b + +# --- third func --------- + +11 +# 0 local variable +00 +# block + 02 + 40 = memory.grow ? + 41 01 = i32.const of value 1 + 45 = i32.eqz + 0d 00 = br_if label 0 + 10 01 = call func id 1 + 0b +10 02 = call func id 2 +10 06 = call func id 6 +00 = unreachable +0b + +# --- fourth func --------- + +02 +00 +0b + +# --- fifth func --------- + +2b = size 43 +# 1 local variable of type i32 (7f) +01 01 7f +41 00 = i32.const of value 0 +21 00 = local.set id 0 (the local variable) + 02 = begin block + 40 = memory.grow ? + 41 00 = i32.const of value 0 + 41 00 = i32.const of value 0 + 4d = i32.le_u + 0d 00 = br_if label 0 + 03 = loop + 40 = memory.grow ? + 20 00 = local.get 0 + 41 7c = i32.const of value -4 ? + 6a = i32.add + 22 00 = local.tee 0 + 28 02 00 = i32.load align 02 offset 00 + 11 01 00 = call_indirect index typeidx 01 typeidx 00 + 20 00 = local.get 0 + 41 00 = i32.const of value 0 + 4b = i32.gt_u + 0d 00 = br_if label 0 + 0b + 0b +10 04 = call func id 4 +0b + +# --- sixth func --------- + +0d +00 +10 04 = call func id 4 +10 05 = call func id 5 +10 04 = call func id 4 +20 00 = local.get 0 +10 07 = call func id 7 +00 = unreachable +0b 07 00 20 00 10 00 00 +0b + +# --- seventh func --------- + +06 +00 +41 = i32.const +c7 c7 04 = value (maybe 65536) +0b + +# --- eighth func --------- + +12 +00 +41 c7 c7 04 = i32.const value (maybe 65536) +24 02 = global.set 2 +41 00 = i32.const of value 0 +41 0f = i32.const of value 15 +6a = i32.add +41 70 = i32.const of value (maybe -16) +71 = i32.and +24 01 = global.set 1 +0b + +# --- ninth func --------- + +07 +# no local variable +00 +23 00 = global.get 0 +23 01 = global.get 1 +6b = i32.sub +0b + +# --- tenth func --------- + +04 +00 +23 02 = global.get 2 +0b + +# --- eleventh func --------- + +04 +00 +23 01 = global.get 1 +0b + +# --- twelfth func --------- + +04 +00 +23 00 = global.get 0 +0b + +# --- thirteenth func --------- + +06 +00 +20 00 = local.get 0 +24 00 = global.set 0 +0b + +# --- fourteenth func --------- + +12 +# number of local variable of type ( see below ) +01 +# 2 locals variable of type i32 (7f) (because 1 variable local of type x ^) +02 7f +23 00 = global.get 0 +20 00 = local.get 0 +6b = i32.sub +41 70 = i32.const of value +71 = i32.and +22 01 = local.tee 1 +24 00 = global.set 0 +20 01 = local.get 1 + + +# ----------------------- 11 ----------------------- + +# id 11 +0b +# size 4 +04 +# Bitfield. 0 = passive segment, 1 = active segment = presence of an explicit memory index +00 +# i32.const +23 +# principal memory +00 +# i32.store +0b diff --git a/lvtrun/app/Loader.hs b/lvtrun/app/Loader.hs new file mode 100644 index 0000000..728c60c --- /dev/null +++ b/lvtrun/app/Loader.hs @@ -0,0 +1,31 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Loader +-} + +module Loader +( + loadModule +) +where + +import System.Environment (getArgs) +import Control.Exception (throw) + +import Types (WasmModule) +import IO (getFileContent) +import Parsing.Parser (parseModule) +import Errors (CustomException(..)) + +getFilePath :: IO String +getFilePath = getArgs >>= \args -> + case args of + [path] -> return path + _ -> throw $ UsageError "Usage: ./run " + +loadModule :: IO WasmModule +loadModule = getFilePath >>= \filePath -> + getFileContent filePath >>= \bytes -> + return $ parseModule bytes diff --git a/lvtrun/app/Main.hs b/lvtrun/app/Main.hs index 0726d58..aff4e51 100644 --- a/lvtrun/app/Main.hs +++ b/lvtrun/app/Main.hs @@ -7,7 +7,14 @@ module Main (main) where -import Lib +import Control.Exception (try) + +import Loader (loadModule) +import Errors (handleException) +import Run.Start (startExecution) main :: IO () -main = someFunc +main = try (startExecution =<< loadModule) >>= \result -> + case result of + Left err -> handleException err + Right _ -> return () diff --git a/lvtrun/lvtrun.cabal b/lvtrun/lvtrun.cabal index 4e28df2..20bc188 100644 --- a/lvtrun/lvtrun.cabal +++ b/lvtrun/lvtrun.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -25,7 +25,26 @@ source-repository head library exposed-modules: - Lib + Errors + IO + Leb128 + OpCodes + Parsing.Code + Parsing.Exports + Parsing.Functions + Parsing.FuncTypes + Parsing.Global + Parsing.Header + Parsing.Memory + Parsing.Parser + Parsing.Sections + Run.Functions + Run.Locals + Run.Stack + Run.Start + Run.Types + Run.Vm + Types other-modules: Paths_lvtrun autogen-modules: @@ -35,11 +54,14 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , binary + , bytestring default-language: Haskell2010 executable lvtrun-exe main-is: Main.hs other-modules: + Loader Paths_lvtrun autogen-modules: Paths_lvtrun @@ -48,6 +70,8 @@ executable lvtrun-exe ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , binary + , bytestring , lvtrun default-language: Haskell2010 @@ -63,5 +87,7 @@ test-suite lvtrun-test ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , binary + , bytestring , lvtrun default-language: Haskell2010 diff --git a/lvtrun/package.yaml b/lvtrun/package.yaml index e1a5e8f..25995fc 100644 --- a/lvtrun/package.yaml +++ b/lvtrun/package.yaml @@ -21,6 +21,8 @@ description: Please see the README on GitHub at = 4.7 && < 5 +- bytestring +- binary ghc-options: - -Wall diff --git a/lvtrun/scripts/build.ps1 b/lvtrun/scripts/build.ps1 new file mode 100644 index 0000000..176db1c --- /dev/null +++ b/lvtrun/scripts/build.ps1 @@ -0,0 +1 @@ +stack build --copy-bins --local-bin-path . diff --git a/lvtrun/src/Errors.hs b/lvtrun/src/Errors.hs new file mode 100644 index 0000000..b86a40a --- /dev/null +++ b/lvtrun/src/Errors.hs @@ -0,0 +1,27 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Errors +-} + +module Errors +( + CustomException(..), + handleException +) +where + +import Control.Exception (Exception(..), SomeException, displayException) + +data CustomException = + ParseError String + | WasmError String + | RuntimeError String + | UsageError String + deriving (Show, Eq) + +instance Exception CustomException + +handleException :: SomeException -> IO () +handleException e = putStrLn $ "Error: " ++ displayException e diff --git a/lvtrun/src/IO.hs b/lvtrun/src/IO.hs new file mode 100644 index 0000000..e3edcd5 --- /dev/null +++ b/lvtrun/src/IO.hs @@ -0,0 +1,19 @@ +{- +-- 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 diff --git a/lvtrun/src/Leb128.hs b/lvtrun/src/Leb128.hs new file mode 100644 index 0000000..a31bb45 --- /dev/null +++ b/lvtrun/src/Leb128.hs @@ -0,0 +1,52 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Leb128 +-} + +module Leb128 +( + getLEB128ToI64, + getLEB128ToI32, +) +where + +import Data.Int (Int64, Int32) +import Data.Binary.Get (Get, getWord8, runGet) +import Data.Bits ((.&.), (.|.), shiftL, testBit) +import qualified Data.ByteString.Lazy as BS (ByteString, drop) + +--------------------- TO INT64 --------------------- + +getLEB128ToI64' :: Get (Int64, Int64) +getLEB128ToI64' = do + byte <- getWord8 + let value = fromIntegral (byte .&. 0x7F) + case byte `testBit` 7 of + True -> do + (next, size) <- getLEB128ToI64' + return (value .|. (next `shiftL` 7), size + 1) + False -> return (value, 1) + +getLEB128ToI64 :: BS.ByteString -> (Int64, BS.ByteString) +getLEB128ToI64 bytes = (value, BS.drop size bytes) + where + (value, size) = runGet getLEB128ToI64' bytes + +--------------------- TO INT32 --------------------- + +getLEB128ToI32' :: Get (Int32, Int64) +getLEB128ToI32' = do + byte <- getWord8 + let value = fromIntegral (byte .&. 0x7F) + case byte `testBit` 7 of + True -> do + (next, size) <- getLEB128ToI32' + return (value .|. (next `shiftL` 7), size + 1) + False -> return (value, 1) + +getLEB128ToI32 :: BS.ByteString -> (Int32, BS.ByteString) +getLEB128ToI32 bytes = (value, BS.drop size bytes) + where + (value, size) = runGet getLEB128ToI32' bytes diff --git a/lvtrun/src/Lib.hs b/lvtrun/src/Lib.hs deleted file mode 100644 index 3f12ee2..0000000 --- a/lvtrun/src/Lib.hs +++ /dev/null @@ -1,13 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Leviator Run --- File description: --- Lib --} - -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/lvtrun/src/OpCodes.hs b/lvtrun/src/OpCodes.hs new file mode 100644 index 0000000..a8788da --- /dev/null +++ b/lvtrun/src/OpCodes.hs @@ -0,0 +1,130 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- OpCodes +-} + +module OpCodes +( + extractOpCode, + createInstruction +) +where + +import Data.Word (Word8) +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as BSL + +import Errors (CustomException(..)) +import Leb128 (getLEB128ToI32, getLEB128ToI64) +import Types (Instruction(..), MemArg(..), BlockType(..)) + +extractOpCode' :: [Word8] -> ([Word8], BSL.ByteString) +extractOpCode' (0x03:rest) = ([0x03], BSL.pack rest) +extractOpCode' (0x11:rest) = ([0x11], BSL.pack rest) +extractOpCode' (0x00:rest) = ([0x00], BSL.pack rest) +extractOpCode' (0x0b:rest) = ([0x0b], BSL.pack rest) +extractOpCode' (0x0d:rest) = ([0x0d], BSL.pack rest) +extractOpCode' (0x0c:rest) = ([0x0c], BSL.pack rest) +extractOpCode' (0x02:rest) = ([0x02], BSL.pack rest) +extractOpCode' (0x01:rest) = ([0x01], BSL.pack rest) +extractOpCode' (0x0f:rest) = ([0x0f], BSL.pack rest) +extractOpCode' (0x10:rest) = ([0x10], BSL.pack rest) +extractOpCode' (0x41:rest) = ([0x41], BSL.pack rest) +extractOpCode' (0x42:rest) = ([0x42], BSL.pack rest) +extractOpCode' (0x6c:rest) = ([0x6c], BSL.pack rest) +extractOpCode' (0x6d:rest) = ([0x6d], BSL.pack rest) +extractOpCode' (0x43:rest) = ([0x43], BSL.pack rest) +extractOpCode' (0x44:rest) = ([0x44], BSL.pack rest) +extractOpCode' (0x28:rest) = ([0x28], BSL.pack rest) +extractOpCode' (0x29:rest) = ([0x29], BSL.pack rest) +extractOpCode' (0x22:rest) = ([0x22], BSL.pack rest) +extractOpCode' (0x36:rest) = ([0x36], BSL.pack rest) +extractOpCode' (0x37:rest) = ([0x37], BSL.pack rest) +extractOpCode' (0x4b:rest) = ([0x4b], BSL.pack rest) +extractOpCode' (0x20:rest) = ([0x20], BSL.pack rest) +extractOpCode' (0x4d:rest) = ([0x4d], BSL.pack rest) +extractOpCode' (0x21:rest) = ([0x21], BSL.pack rest) +extractOpCode' (0x23:rest) = ([0x23], BSL.pack rest) +extractOpCode' (0x24:rest) = ([0x24], BSL.pack rest) +extractOpCode' (0x6a:rest) = ([0x6a], BSL.pack rest) +extractOpCode' (0x6b:rest) = ([0x6b], BSL.pack rest) +extractOpCode' (0x45:rest) = ([0x45], BSL.pack rest) +extractOpCode' (0x46:rest) = ([0x46], BSL.pack rest) +extractOpCode' (0x71:rest) = ([0x71], BSL.pack rest) +extractOpCode' (0x48:rest) = ([0x48], BSL.pack rest) +extractOpCode' (0x4a:rest) = ([0x4a], BSL.pack rest) +extractOpCode' (0x4c:rest) = ([0x4c], BSL.pack rest) +extractOpCode' (0x4e:rest) = ([0x4e], BSL.pack rest) +extractOpCode' (0x47:rest) = ([0x47], BSL.pack rest) +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' _ = throw $ WasmError "ExtractOpCode: bad opcode" + +extractOpCode :: BSL.ByteString -> ([Word8], BSL.ByteString) +extractOpCode bytes = extractOpCode' (BSL.unpack bytes) + +createInstruction :: [Word8] -> BSL.ByteString -> (Instruction, BSL.ByteString) +createInstruction [0x03] bytes = (Nop, bytes) +createInstruction [0x11] bytes = (Nop, bytes) +createInstruction [0x00] bytes = (Unreachable, bytes) +createInstruction [0x01] bytes = (Nop, bytes) +createInstruction [0x02] bytes = (Block EmptyType, bytes) +createInstruction [0x0b] bytes = (End, bytes) +createInstruction [0x48] bytes = (I32Lts, bytes) +createInstruction [0x0f] bytes = (Return, bytes) +createInstruction [0x4b] bytes = (I32Gtu, bytes) +createInstruction [0x6a] bytes = (I32Add, bytes) +createInstruction [0x6c] bytes = (I32Mul, bytes) +createInstruction [0x6d] bytes = (I32Divs, bytes) +createInstruction [0x47] bytes = (I32Ne, bytes) +createInstruction [0x6b] bytes = (I32Sub, bytes) +createInstruction [0x4a] bytes = (I32Gts, bytes) +createInstruction [0x46] bytes = (I32Eq, bytes) +createInstruction [0x45] bytes = (I32Eqz, bytes) +createInstruction [0x4d] bytes = (I32Leu, bytes) +createInstruction [0x4e] bytes = (I32Ges, bytes) +createInstruction [0x4c] bytes = (I32Les, bytes) +createInstruction [0x71] bytes = (I32And, bytes) +createInstruction [0x04, 0x40] bytes = (If, bytes) +createInstruction [0x3f, 0x00] bytes = (MemorySize, bytes) +createInstruction [0x40, 0x00] bytes = (MemoryGrow, bytes) +createInstruction [0x0d] bytes = (\(value, rest) -> + (BrIf value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x0c] bytes = (\(value, rest) -> + (Br value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x22] bytes = (\(value, rest) -> + (LocalTee value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x10] bytes = (\(value, rest) -> + (Call value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x41] bytes = (\(value, rest) -> + (I32Const value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x42] bytes = (\(value, rest) -> + (I64Const value, rest)) (getLEB128ToI64 bytes) +createInstruction [0x43] bytes = (\(value, rest) -> + (F32Const (fromIntegral value), rest)) (getLEB128ToI32 bytes) +createInstruction [0x20] bytes = (\(value, rest) -> + (GetLocal value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x24] bytes = (\(value, rest) -> + (SetGlobal value, rest)) (getLEB128ToI32 bytes) +createInstruction [0x23] bytes = (\(value, rest) -> + (GetGlobal value, rest)) (getLEB128ToI32 bytes) +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)) + (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) +createInstruction [0x29] bytes = (\(align, rest) -> + (\(offset, rest2) -> (I64Load (MemArg offset align), rest2)) + (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) +createInstruction [0x36] bytes = (\(align, rest) -> + (\(offset, rest2) -> (I32Store (MemArg offset align), rest2)) + (getLEB128ToI32 rest)) (getLEB128ToI32 bytes) +createInstruction [0x37] bytes = (\(align, rest) -> + (\(offset, rest2) -> (I64Store (MemArg offset align), 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 new file mode 100644 index 0000000..12f992d --- /dev/null +++ b/lvtrun/src/Parsing/Code.hs @@ -0,0 +1,88 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Code +-} + +module Parsing.Code +( + getFuncCode, +) +where + +import Data.Int (Int64) +import Control.Monad (when) +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as BSL + +import Types +import Leb128 (getLEB128ToI64) +import Errors (CustomException(..)) +import OpCodes (extractOpCode, createInstruction) + +diviseBytes :: BSL.ByteString -> [BSL.ByteString] +diviseBytes bytes + | BSL.length bytes == 0 = [] + | otherwise = code : diviseBytes rest2 + where + (size, rest) = getLEB128ToI64 bytes + (code, rest2) = BSL.splitAt size rest + +createLocal :: LocalIdx -> TypeName -> Local +createLocal idx typee = Local {lcIdx = idx, lcType = typee} + +extractLocal :: Int64 -> BSL.ByteString -> ([Local], BSL.ByteString) +extractLocal id bytes + | BSL.length bytes == 0 = throw $ WasmError "extractLocal: bad section" + | otherwise = (locals, 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] + +extractLocals :: Int64 -> Int64 -> BSL.ByteString -> ([Local], BSL.ByteString) +extractLocals id idMax bytes + | id >= idMax = ([], bytes) + | BSL.length bytes == 0 = ([], bytes) + | otherwise = (local ++ locals, rest2) + where + (local, rest) = extractLocal id bytes + (locals, rest2) = extractLocals (id + 1) idMax rest + +------------------------- + +parseInstruction :: BSL.ByteString -> (Instruction, BSL.ByteString) +parseInstruction bytes + | BSL.length bytes == 0 = + throw $ WasmError "ParseInstruction: no instruction" + | otherwise = createInstruction opCode rest + where + (opCode, rest) = extractOpCode bytes + +extractCode :: BSL.ByteString -> [Instruction] +extractCode bytes + | BSL.length bytes == 0 = [] + | otherwise = instruction : extractCode rest + where + (instruction, rest) = parseInstruction bytes + +parseFunction :: BSL.ByteString -> Function -> Function +parseFunction bytes func = func {locals = lcals, body = extractCode rest2} + where + (nbLocalsTypes, rest) = getLEB128ToI64 bytes + (lcals, rest2) = extractLocals 0 nbLocalsTypes rest + +parseFunctions :: [BSL.ByteString] -> [Function] -> [Function] +parseFunctions [] [] = [] +parseFunctions [] _ = throw $ WasmError "parseFunctions: bad section" +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 + where + (nbFunc, rest) = getLEB128ToI64 content + funcCodes = diviseBytes rest +getFuncCode _ _ = throw $ WasmError "getFuncCode: bad section" diff --git a/lvtrun/src/Parsing/Exports.hs b/lvtrun/src/Parsing/Exports.hs new file mode 100644 index 0000000..f2617d7 --- /dev/null +++ b/lvtrun/src/Parsing/Exports.hs @@ -0,0 +1,61 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Exports +-} + +module Parsing.Exports +( + getExports +) +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 + +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 + +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 _ _ _ = throw $ WasmError "createExport: bad export" + +parseExports :: Int32 -> Int64 -> Bs.ByteString -> [Export] +parseExports idx maxIdx content + | idx >= (fromIntegral maxIdx) = [] + | Bs.length content == 0 = [] + | otherwise = export : parseExports (idx + 1) maxIdx rest3 + where + (nameLen, rest) = getLEB128ToI64 content + (name, rest2) = Bs.splitAt nameLen rest + exportType = head (Bs.unpack rest2) + (exportValue, rest3) = getLEB128ToI32 (Bs.drop 1 rest2) + export = createExport (Bs.unpack name) exportType exportValue + +getExports :: Section -> [Export] +getExports (Section ExportID _ content) = parseExports 0 exprtsNb rest + where + (exprtsNb, rest) = getExportNb content +getExports _ = throw $ WasmError "getExports: bad section" diff --git a/lvtrun/src/Parsing/FuncTypes.hs b/lvtrun/src/Parsing/FuncTypes.hs new file mode 100644 index 0000000..29110b5 --- /dev/null +++ b/lvtrun/src/Parsing/FuncTypes.hs @@ -0,0 +1,48 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Types +-} + +module Parsing.FuncTypes +( + getFuncTypes +) +where + +import Data.Int (Int64, Int32) +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as Bs + +import Types +import Leb128 (getLEB128ToI64) +import Errors (CustomException(..)) + +getVectorSize :: Bs.ByteString -> (Int64, Bs.ByteString) +getVectorSize content = getLEB128ToI64 content + +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 :: Int32 -> Bs.ByteString -> (FuncType, Bs.ByteString) +parseFuncType id content = (FuncType id params results, rest2) + where + (params, rest) = extractTypes (getVectorSize content) + (results, rest2) = extractTypes (getVectorSize rest) + +parseFuncTypes :: Int32 -> Int64 -> Bs.ByteString -> [FuncType] +parseFuncTypes idx maxIdx content + | idx >= (fromIntegral maxIdx) = [] + | head (Bs.unpack content) == 0x60 = + funcType : parseFuncTypes (idx + 1) maxIdx rest + | otherwise = throw $ WasmError "ParseFuncTypes: 0x60 expected for function" + where (funcType, rest) = parseFuncType idx (Bs.drop 1 content) + +getFuncTypes :: Section -> [FuncType] +getFuncTypes (Section TypeID _ content) = parseFuncTypes 0 vecSize rest + where (vecSize, rest) = getLEB128ToI64 content +getFuncTypes _ = throw $ WasmError "getFuncTypes: bad section" diff --git a/lvtrun/src/Parsing/Functions.hs b/lvtrun/src/Parsing/Functions.hs new file mode 100644 index 0000000..1bb7c4b --- /dev/null +++ b/lvtrun/src/Parsing/Functions.hs @@ -0,0 +1,38 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Functions +-} + +module Parsing.Functions +( + getFunctions +) +where + +import qualified Data.ByteString.Lazy as BSL +import Control.Exception (throw) +import Data.Int (Int64, Int32) + +import Types +import Errors +import Leb128 + +parseFunctionsIndex :: Int32 -> Int64 -> BSL.ByteString -> [Function] +parseFunctionsIndex idx maxIdx content + | idx > (fromIntegral maxIdx) = [] + | BSL.length content == 0 = [] + | otherwise = + Function { + funcType = fromIntegral typeIdx, + funcIdx = idx, + body = [] + } : parseFunctionsIndex (idx + 1) maxIdx rest + where (typeIdx, rest) = getLEB128ToI32 content + +getFunctions :: Section -> [Function] +getFunctions (Section FunctionID _ content) = + parseFunctionsIndex 0 vecSize rest + where (vecSize, rest) = getLEB128ToI64 content +getFunctions _ = throw $ WasmError "getFunctions: bad section" diff --git a/lvtrun/src/Parsing/Global.hs b/lvtrun/src/Parsing/Global.hs new file mode 100644 index 0000000..81c6a76 --- /dev/null +++ b/lvtrun/src/Parsing/Global.hs @@ -0,0 +1,80 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Global +-} + +module Parsing.Global + ( + getGlobals, + ) +where + +import Data.Int (Int64) +import Data.Word (Word8) +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as BSL + +import Types +import Errors (CustomException(..)) +import Leb128 (getLEB128ToI64) +import OpCodes (extractOpCode, createInstruction) + +parseInstruction :: BSL.ByteString -> (Instruction, BSL.ByteString) +parseInstruction bytes + | BSL.length bytes == 0 = + throw $ WasmError "ParseInstruction: no instruction" + | otherwise = (instruction, rest2) + where + (opCode, rest) = extractOpCode bytes + (instruction, rest2) = createInstruction opCode rest + +parseInstructions :: BSL.ByteString -> [Instruction] +parseInstructions bytes + | BSL.length bytes == 0 = [] + | head (BSL.unpack bytes) == 0x0b = [] + | otherwise = instruction : parseInstructions rest + where + (instruction, rest) = parseInstruction bytes + +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 = (expression, rest) + where + idx = getHexaIndex content 0 + expression = BSL.take (fromIntegral (idx + 1)) content + rest = BSL.drop (fromIntegral (idx + 1)) content + +parseGlobal :: BSL.ByteString -> (Global, BSL.ByteString) +parseGlobal content = (Global globalType mutability 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) + instructions = parseInstructions expression + +parseGlobals :: Int64 -> Int64 -> BSL.ByteString -> [Global] +parseGlobals idx maxIdx content + | idx >= maxIdx = [] + | otherwise = global : parseGlobals (idx + 1) maxIdx rest + where + (global, rest) = parseGlobal content + +getGlobals :: Section -> [Global] +getGlobals (Section GlobalID _ content) = + parseGlobals 0 vecSize rest + where + (vecSize, rest) = getLEB128ToI64 content +getGlobals _ = throw $ WasmError "getGlobals: bad section" diff --git a/lvtrun/src/Parsing/Header.hs b/lvtrun/src/Parsing/Header.hs new file mode 100644 index 0000000..15f1a63 --- /dev/null +++ b/lvtrun/src/Parsing/Header.hs @@ -0,0 +1,27 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Header +-} + +module Parsing.Header +( + getModHeader, + isHeaderValid +) +where + +import qualified Data.ByteString.Lazy as BSL (take, drop, pack) + +import Types (ModHeader(..), Section(..)) + +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] diff --git a/lvtrun/src/Parsing/Memory.hs b/lvtrun/src/Parsing/Memory.hs new file mode 100644 index 0000000..455681f --- /dev/null +++ b/lvtrun/src/Parsing/Memory.hs @@ -0,0 +1,45 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Memory +-} + +module Parsing.Memory +( + getMemories +) where + +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as BS (ByteString, drop, unpack, empty) + +import Types +import Leb128 (getLEB128ToI32) +import Errors (CustomException(..)) + +parseMinMax :: BS.ByteString -> Memory +parseMinMax content + | endBs /= BS.empty = throw $ WasmError "parseMinMax: bad memory section" + | otherwise = Limit {lMin = min, lMax = Just max} + where + (min, rest) = getLEB128ToI32 content + (max, endBs) = getLEB128ToI32 rest + +parseMin :: BS.ByteString -> Memory +parseMin content + | endBs /= BS.empty = throw $ WasmError "parseMin: bad memory section" + | otherwise = Limit {lMin = min, lMax = Nothing} + where + (min, endBs) = getLEB128ToI32 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" diff --git a/lvtrun/src/Parsing/Parser.hs b/lvtrun/src/Parsing/Parser.hs new file mode 100644 index 0000000..cb81338 --- /dev/null +++ b/lvtrun/src/Parsing/Parser.hs @@ -0,0 +1,33 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Parser +-} + +module Parsing.Parser +( + parseModule, +) +where + +import Types +import qualified Parsing.Header as PH +import qualified Parsing.FuncTypes as FT +import qualified Parsing.Functions as FN +import qualified Parsing.Memory as M +import qualified Parsing.Exports as E +import qualified Parsing.Sections as S +import qualified Parsing.Global as G +import qualified Parsing.Code as C + +parseModule :: FileContent -> WasmModule +parseModule bytes = WasmModule { + header = PH.getModHeader (S.getSectionWithId sections CustomID), + types = FT.getFuncTypes (S.getSectionWithId sections TypeID), + imports = [], functions = C.getFuncCode (S.getSectionWithId sections CodeID) + (FN.getFunctions (S.getSectionWithId sections FunctionID)), + tables = [], globals = G.getGlobals (S.getSectionWithId sections GlobalID), + memory = M.getMemories (S.getSectionWithId sections MemoryID), + exports = E.getExports (S.getSectionWithId sections ExportID)} + where sections = S.getSections bytes diff --git a/lvtrun/src/Parsing/Sections.hs b/lvtrun/src/Parsing/Sections.hs new file mode 100644 index 0000000..8fa167e --- /dev/null +++ b/lvtrun/src/Parsing/Sections.hs @@ -0,0 +1,70 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Parser +-} + +module Parsing.Sections +( + getSections, + getSectionWithId +) +where + +import Data.Word (Word8) +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as BSL + +import Leb128 (getLEB128ToI64) +import Errors (CustomException(..)) +import Types (FileContent, Section(..), SectionID(..)) + +extractHeader :: BSL.ByteString -> (Section, BSL.ByteString) +extractHeader bytes + | (BSL.length bytes) < 8 = throw (WasmError "Invalid header") + | otherwise = (Section CustomID 8 (BSL.take 8 bytes), BSL.drop 8 bytes) + +getSectionId' :: Word8 -> SectionID +getSectionId' 0 = CustomID +getSectionId' 1 = TypeID +getSectionId' 2 = ImportID +getSectionId' 3 = FunctionID +getSectionId' 4 = TableID +getSectionId' 5 = MemoryID +getSectionId' 6 = GlobalID +getSectionId' 7 = ExportID +getSectionId' 8 = StartID +getSectionId' 9 = ElementID +getSectionId' 10 = CodeID +getSectionId' 11 = DataID +getSectionId' _ = throw (WasmError "Invalid section id") + +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) + where + sectionId = getSectionId bytes + (size, rest) = getLEB128ToI64 (BSL.drop 1 bytes) + (content, rest2) = BSL.splitAt size rest + +extractSections :: BSL.ByteString -> [Section] +extractSections bytes + | BSL.length bytes == 0 = [] + | otherwise = section : extractSections rest + where + (section, rest) = extractSection bytes + +getSections :: FileContent -> [Section] +getSections bytes = header : sections + where + (header, rest) = extractHeader bytes + sections = extractSections rest + +getSectionWithId :: [Section] -> SectionID -> Section +getSectionWithId [] _ = throw (WasmError "No section with this id") +getSectionWithId (x:xs) id + | identifier x == id = x + | otherwise = getSectionWithId xs id diff --git a/lvtrun/src/Run/Functions.hs b/lvtrun/src/Run/Functions.hs new file mode 100644 index 0000000..293a968 --- /dev/null +++ b/lvtrun/src/Run/Functions.hs @@ -0,0 +1,46 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Functions +-} + +module Run.Functions +( + getStartFunctionId, + getFunctionFromId, + getStartFunction, + getFuncTypeFromId +) +where + +import Data.Int (Int32) +import Control.Exception (throw) + +import Errors (CustomException(..)) +import Types (Export(..), ExportDesc(..), Function(..), FuncType(..)) + +getStartFunctionId :: [Export] -> Int32 +getStartFunctionId [] = throw $ WasmError "No start function" +getStartFunctionId (x:xs) + | expName x == "start" = + case expDesc x of + ExportFunc idx -> idx + _ -> throw $ WasmError "getStartFunctionId: bad export" + | otherwise = getStartFunctionId xs + +getFunctionFromId :: Int32 -> [Function] -> Function +getFunctionFromId _ [] = throw $ WasmError "getFunctionFromId: bad id" +getFunctionFromId id (x:xs) + | funcIdx x == id = x + | otherwise = getFunctionFromId id xs + +getStartFunction :: [Export] -> [Function] -> Function +getStartFunction exports functions = + getFunctionFromId (getStartFunctionId exports) functions + +getFuncTypeFromId :: Int32 -> [FuncType] -> FuncType +getFuncTypeFromId _ [] = throw $ WasmError "getFuncTypeFromId: bad id" +getFuncTypeFromId id (x:xs) + | typeId x == id = x + | otherwise = getFuncTypeFromId id xs diff --git a/lvtrun/src/Run/Locals.hs b/lvtrun/src/Run/Locals.hs new file mode 100644 index 0000000..4c9c30f --- /dev/null +++ b/lvtrun/src/Run/Locals.hs @@ -0,0 +1,95 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Locals +-} + +module Run.Locals +( + Locals, + getLocalFromId, + setLocalWithId, + initLocals, + createEmptyLocals +) +where + +import Data.Int (Int32) +import Control.Exception (throw) + +import Types +import Errors (CustomException(..)) +import Run.Stack (Stack, stackPopN) + +type Locals = [Value] + +getLocalFromId' :: Int32 -> LocalIdx -> Locals -> Value +getLocalFromId' _ _ [] = throw $ WasmError "getLocalFromId: bad id" +getLocalFromId' idx idntifier (x:xs) + | idx > idntifier = throw $ WasmError "getLocalFromId: bad id" + | idx == idntifier = x + | otherwise = getLocalFromId' (idx + 1) idntifier xs + +getLocalFromId :: Locals -> LocalIdx -> Value +getLocalFromId lcals idntifier = getLocalFromId' 0 idntifier lcals + +setLocalWithId :: Int32 -> Locals -> Value -> LocalIdx -> Locals +setLocalWithId _ [] _ _ = throw $ WasmError "setLocalWithId: bad id" +setLocalWithId idx (x:xs) value idntifier + | idx > idntifier = throw $ WasmError "setLocalWithId: bad id" + | idx == idntifier = value : xs + | otherwise = x : setLocalWithId (idx + 1) xs value idntifier + +----------- INITIALISATION ---------------- + +initLocalsVar :: Locals -> [Local] -> Locals +initLocalsVar newLocals [] = newLocals +initLocalsVar newLocals ((Local _ I32):xs) = + initLocalsVar (I_32 0 : newLocals) xs +initLocalsVar newLocals ((Local _ I64):xs) = + initLocalsVar (I_64 0 : newLocals) xs +initLocalsVar newLocals ((Local _ F32):xs) = + initLocalsVar (F_32 0 : newLocals) xs +initLocalsVar newLocals ((Local _ F64):xs) = + initLocalsVar (F_64 0 : newLocals) xs + +createLocalsParams :: [TypeName] -> [Value] -> Locals +createLocalsParams [] [] = [] +createLocalsParams (I32:xs) (I_32 val:xs2) = + (I_32 val : createLocalsParams xs xs2) +createLocalsParams (I64:xs) (I_64 val:xs2) = + (I_64 val : createLocalsParams xs xs2) +createLocalsParams (F32:xs) (F_32 val:xs2) = + (F_32 val : createLocalsParams xs xs2) +createLocalsParams (F64:xs) (F_64 val:xs2) = + (F_64 val : createLocalsParams xs xs2) +createLocalsParams _ _ = throw $ WasmError "createLocalsParams: bad type" + +initLocalsParams' :: (Locals, Stack) -> [TypeName] -> (Locals, Stack) +initLocalsParams' ([], newStack) _ = ([], newStack) +initLocalsParams' (values, newStack) prms = + (createLocalsParams prms (reverse values), newStack) + +initLocalsParams :: [TypeName] -> Stack -> (Locals, Stack) +initLocalsParams [] stack = ([], stack) +initLocalsParams prms stack + | length prms > length stack = throw $ WasmError "initLocalsParam: bad nb" + | otherwise = initLocalsParams' (stackPopN stack (length prms)) prms + +initLocals :: [Local] -> [TypeName] -> Stack -> (Locals, Stack) +initLocals localVarTypes paramTypes stack = (newLocals ++ localsVar, newStack) + where + (newLocals, newStack) = initLocalsParams paramTypes stack + localsVar = initLocalsVar newLocals localVarTypes + +createEmptyLocals :: Locals -> [Local] -> Locals +createEmptyLocals newLocals [] = newLocals +createEmptyLocals newLocals ((Local _ I32):xs) = + createEmptyLocals (I_32 0 : newLocals) xs +createEmptyLocals newLocals ((Local _ I64):xs) = + createEmptyLocals (I_64 0 : newLocals) xs +createEmptyLocals newLocals ((Local _ F32):xs) = + createEmptyLocals (F_32 0 : newLocals) xs +createEmptyLocals newLocals ((Local _ F64):xs) = + createEmptyLocals (F_64 0 : newLocals) xs diff --git a/lvtrun/src/Run/Stack.hs b/lvtrun/src/Run/Stack.hs new file mode 100644 index 0000000..399b209 --- /dev/null +++ b/lvtrun/src/Run/Stack.hs @@ -0,0 +1,63 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Stack +-} + +module Run.Stack +( + Stack, + pushResults, + stackPush, + stackPop, + stackTop, + stackPopN +) +where + +import Control.Exception (throw) + +import Errors (CustomException(..)) +import Types (Value(..), TypeName(..)) + +type Stack = [Value] + +pushResults :: Stack -> Stack -> [TypeName] -> Stack +pushResults toStack _ [] = toStack +pushResults toStack fromStack ((I32):xs) = + case stackTop fromStack of + I_32 val -> pushResults (stackPush toStack (I_32 val)) (tail fromStack) xs + _ -> throw $ RuntimeError "pushResults: bad type" +pushResults toStack fromStack ((I64):xs) = + case stackTop fromStack of + I_64 val -> pushResults (stackPush toStack (I_64 val)) (tail fromStack) xs + _ -> throw $ RuntimeError "pushResults: bad type" +pushResults toStack fromStack ((F32):xs) = + case stackTop fromStack of + F_32 val -> pushResults (stackPush toStack (F_32 val)) (tail fromStack) xs + _ -> throw $ RuntimeError "pushResults: bad type" +pushResults toStack fromStack ((F64):xs) = + case stackTop fromStack of + F_64 val -> pushResults (stackPush toStack (F_64 val)) (tail fromStack) xs + _ -> throw $ RuntimeError "pushResults: bad type" + +stackPush :: Stack -> Value -> Stack +stackPush stack value = value:stack + +stackPop :: Stack -> (Value, Stack) +stackPop [] = throw $ RuntimeError "stackPop: empty stack" +stackPop (x:xs) = (x, xs) + +stackTop :: Stack -> Value +stackTop [] = throw $ RuntimeError "stackTop: empty stack" +stackTop (x:_) = x + +stackPopN :: Stack -> Int -> ([Value], Stack) +stackPopN stack 0 = ([], stack) +stackPopN stack n + | n > 0 = (value : values, finalStack) + | otherwise = error "stackPopN: bad n" + where + (value, newStack) = stackPop stack + (values, finalStack) = stackPopN newStack (n - 1) diff --git a/lvtrun/src/Run/Start.hs b/lvtrun/src/Run/Start.hs new file mode 100644 index 0000000..1204f72 --- /dev/null +++ b/lvtrun/src/Run/Start.hs @@ -0,0 +1,28 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Code +-} + +module Run.Start +( + startExecution +) +where + +import Types +import Run.Vm (runMain) +import Run.Stack (Stack) +import Run.Types (createVm) +import Run.Functions (getStartFunctionId) + +exitCorrectly :: Stack -> IO () +exitCorrectly [] = putStrLn "Exit correctly with code: 0" +exitCorrectly (x:_) = putStrLn $ "Exit correctly with code: " ++ show x + +startExecution :: WasmModule -> IO () +startExecution wasmMod = exitCorrectly $ vmAtEnd + where + vmAtEnd = runMain (createVm wasmMod) startFuncId + startFuncId = getStartFunctionId (exports wasmMod) diff --git a/lvtrun/src/Run/Types.hs b/lvtrun/src/Run/Types.hs new file mode 100644 index 0000000..e3f8de6 --- /dev/null +++ b/lvtrun/src/Run/Types.hs @@ -0,0 +1,77 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Types +-} + +module Run.Types +( + CurrentExec(..), + InstMemory(..), + VM(..), + createVm, + incrementInstIdx, + createEmptyExec, + decrementBlockIdx +) +where + +import Data.Word (Word8) + +import Types +import Run.Stack (Stack) +import Run.Locals (Locals) + +data CurrentExec = CurrentExec { + ceLocals :: Locals, + ceStack :: Stack, + ceInstructions :: [Instruction], + ceInstIdx :: Int, + ceLabels :: [Int], + ceParams :: [TypeName], + ceResults :: [TypeName], + crBlockIndents :: Int +} deriving (Show) + +data InstMemory = Memory { + memRange :: Limit, + memData :: [Word8] +} deriving (Show) + +data VM = VM { + vmStack :: Stack, + currentExec :: CurrentExec, + vmMemory :: InstMemory, + wasmModule :: WasmModule +} deriving (Show) + +createVm :: WasmModule -> VM +createVm wasmMod = VM { vmStack = [], + currentExec = CurrentExec { ceLocals = [], + ceStack = [], ceInstructions = [], + ceParams = [], ceResults = [], ceInstIdx = 0, + ceLabels = [], crBlockIndents = 0}, + vmMemory = Memory { + memRange = Limit 0 Nothing, memData = [] + }, + wasmModule = wasmMod +} + +incrementInstIdx :: CurrentExec -> CurrentExec +incrementInstIdx cEx = cEx { ceInstIdx = ceInstIdx cEx + 1 } + +decrementBlockIdx :: CurrentExec -> CurrentExec +decrementBlockIdx cEx = cEx { crBlockIndents = (crBlockIndents cEx) - 1 } + +createEmptyExec :: CurrentExec +createEmptyExec = CurrentExec { + ceLocals = [], + ceStack = [], + ceInstructions = [], + ceInstIdx = 0, + ceLabels = [], + ceParams = [], + ceResults = [], + crBlockIndents = 0 +} diff --git a/lvtrun/src/Run/Vm.hs b/lvtrun/src/Run/Vm.hs new file mode 100644 index 0000000..6bee410 --- /dev/null +++ b/lvtrun/src/Run/Vm.hs @@ -0,0 +1,172 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Vm +-} + +module Run.Vm +( + VM(..), + runMain, + createVm +) +where + +import Data.Int (Int32) +import Control.Exception (throw) + +import Types +import Run.Types +import Run.Locals +import Errors (CustomException(..)) +import Run.Functions (getFunctionFromId, getFuncTypeFromId) +import Run.Stack (Stack, stackPush, stackPop, stackTop, pushResults, stackPopN) + +goToEndInstruction :: CurrentExec -> CurrentExec +goToEndInstruction cexec + | ceInstIdx cexec >= length (ceInstructions cexec) = + throw $ RuntimeError "goToEndInstruction: missing end instruction" + | currentOpCode == End = cexec { ceInstIdx = (ceInstIdx cexec) } + | otherwise = goToEndInstruction (incrementInstIdx cexec) + where + currentOpCode = (ceInstructions cexec) !! (ceInstIdx cexec) + +execI32Const :: CurrentExec -> Int32 -> CurrentExec +execI32Const cEx val = cEx {ceStack = stackPush (ceStack cEx) (I_32 val)} + +execI32Eqz :: CurrentExec -> CurrentExec +execI32Eqz cEx@(CurrentExec {ceStack = stack}) = + case (stackTop stack) of + I_32 0 -> cEx { ceStack = stackPush stack (I_32 1) } + I_32 _ -> cEx { ceStack = stackPush stack (I_32 0) } + _ -> throw $ RuntimeError "exec I32eqz: bad type" + +execI32Add :: CurrentExec -> CurrentExec +execI32Add cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> + cEx { ceStack = stackPush newStack (I_32 (val1 + val2)) } + _ -> throw $ RuntimeError "exec I32add: bad type" + +execI32Eq :: CurrentExec -> CurrentExec +execI32Eq cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 value2, I_32 value1], newStack) -> case (value1 == value2) of + True -> cEx { ceStack = stackPush newStack (I_32 1) } + False -> cEx { ceStack = stackPush newStack (I_32 0) } + _ -> throw $ RuntimeError "exec I32Eq: bad type" + +execI32Sub :: CurrentExec -> CurrentExec +execI32Sub cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> + cEx { ceStack = stackPush newStack (I_32 (val1 - val2)) } + _ -> throw $ RuntimeError "exec I32sub: bad type" + +execI32Mul :: CurrentExec -> CurrentExec +execI32Mul cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> + cEx { ceStack = stackPush newStack (I_32 (val1 * val2)) } + _ -> throw $ RuntimeError "exec I32mul: bad type" + +execI32Divs :: CurrentExec -> CurrentExec +execI32Divs cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> + cEx { ceStack = stackPush newStack (I_32 (val1 `div` val2)) } + _ -> throw $ RuntimeError "exec I32divs: bad type" + +execGetLocal :: CurrentExec -> LocalIdx -> CurrentExec +execGetLocal cEx localIdx = cEx { ceStack = + stackPush (ceStack cEx) (getLocalFromId (ceLocals cEx) localIdx)} + +execSetLocal :: CurrentExec -> LocalIdx -> CurrentExec +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}) = + case (stackTop stack) of + I_32 0 -> cEx + I_32 _ -> cEx { ceInstIdx = (ceInstIdx cEx) } + _ -> throw $ RuntimeError "exec brIf: bad type" + +execCall :: VM -> CurrentExec -> FuncIdx -> CurrentExec +execCall vm cEx funcIdx = cEx { ceStack = newStack } + where + newVm = execFunctionWithIdx vm funcIdx currentStack + newStack = pushResults currentStack (vmStack newVm) res + currentStack = ceStack cEx + res = ceResults (currentExec newVm) + +execIf :: CurrentExec -> CurrentExec +execIf cEx@(CurrentExec {ceStack = stack}) = case stackTop stack of + I_32 0 -> goToEndInstruction cEx + I_32 1 -> cEx { crBlockIndents = (crBlockIndents cEx) + 1 } + I_32 _ -> throw $ RuntimeError "execIf: bad if statement" + _ -> throw $ RuntimeError "execIf: bad type" + +execOpCode :: VM -> CurrentExec -> Instruction -> CurrentExec +execOpCode _ cEx (Unreachable) = throw $ RuntimeError "execOpCode: unreachable" +execOpCode _ cEx (End) = decrementBlockIdx cEx +execOpCode _ cEx (Return) = decrementBlockIdx cEx +execOpCode _ cEx (I32Const val) = execI32Const cEx val +execOpCode _ cEx (I32Eqz) = execI32Eqz cEx +execOpCode _ cEx (Block _) = cEx { crBlockIndents = (crBlockIndents cEx) + 1 } +execOpCode _ cEx (I32Eq) = execI32Eq cEx +execOpCode _ cEx (I32Add) = execI32Add cEx +execOpCode _ cEx (I32Sub) = execI32Sub cEx +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 (If) = execIf cEx +execOpCode _ cEx _ = cEx + +execOpCodes :: VM -> [Instruction] -> CurrentExec +execOpCodes vm [] = currentExec vm +execOpCodes vm instructions + | ceInstIdx cEx >= length instructions = cEx + | ceInstIdx cEx < 0 = throw $ RuntimeError "execOpCodes: bad index" + | currentInst == End && crBlockIndents cEx == 0 = cEx + | currentInst == Return = cEx { ceInstIdx = (length instructions) } + | otherwise = execOpCodes newVm instructions + where cEx = currentExec vm + newCEx = execOpCode vm cEx (instructions !! ceInstIdx cEx) + newVm = vm { currentExec = (incrementInstIdx newCEx) } + currentInst = instructions !! ceInstIdx cEx + +execFunction :: VM -> VM +execFunction vm = vm { currentExec = newCEx, vmStack = stackWithRes } + where + newCEx = execOpCodes vm (ceInstructions (currentExec vm)) + stackWithRes = pushResults (vmStack vm) (ceStack newCEx) + (ceResults newCEx) + +execFunctionWithIdx :: VM -> FuncIdx -> Stack -> VM +execFunctionWithIdx vm funcIdx currentStack = + execFunction vm { currentExec = cexec } + where + function = getFunctionFromId funcIdx (functions (wasmModule vm)) + funcTypee = getFuncTypeFromId (funcType function) (types (wasmModule vm)) + (newLocals, newStack) = + initLocals (locals function) (params funcTypee) currentStack + cexec = createEmptyExec { + ceLocals = newLocals, ceStack = newStack, ceInstructions = body function, + ceParams = params funcTypee, ceResults = results funcTypee} + +runMain :: VM -> FuncIdx -> Stack +runMain vm funcIdx = pushResults[](vmStack newVm)(ceResults(currentExec newVm)) + where + function = getFunctionFromId funcIdx (functions (wasmModule vm)) + funcTypee = getFuncTypeFromId (funcType function) (types (wasmModule vm)) + cexec = createEmptyExec { + ceLocals = createEmptyLocals [] (locals function), + ceInstructions = body function, + ceParams = params funcTypee, ceResults = results funcTypee} + newVm = execFunction vm { currentExec = cexec } diff --git a/lvtrun/src/Types.hs b/lvtrun/src/Types.hs new file mode 100644 index 0000000..6807b19 --- /dev/null +++ b/lvtrun/src/Types.hs @@ -0,0 +1,297 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator Run +-- File description: +-- Types +-} + +module Types +( + TypeName(..), + Limit(..), + MemArg(..), + Instruction(..), + TypeIdx, + FuncIdx, + TableIdx, + MemIdx, + GlobalIdx, + ElemIdx, + DataIdx, + LocalIdx, + LabelIdx, + FuncType(..), + Import(..), + ImportDesc(..), + Function(..), + Mutability(..), + Global(..), + ExportDesc(..), + Export(..), + Table(..), + WasmModule(..), + getTypeFromByte, + ModHeader(..), + FileContent, + SectionID(..), + Section(..), + Memory, + Local(..), + BlockType(..), + Value(..) +) where + +import Data.Int (Int32, Int64) +import Data.Word (Word8) +import Control.Exception (throw) +import qualified Data.ByteString.Lazy as BSL + +import Errors + +-- Indices +type TypeIdx = Int32 +type FuncIdx = Int32 +type TableIdx = Int32 +type MemIdx = Int32 +type GlobalIdx = Int32 +type ElemIdx = Int32 +type DataIdx = Int32 +type LocalIdx = Int32 +type LabelIdx = Int32 + +type FileContent = BSL.ByteString + +type Memory = Limit + +data TypeName = + I32 + | I64 + | F32 + | F64 + deriving (Show, Eq, Enum) + +data Limit = Limit { + lMin :: Int32, + lMax :: Maybe Int32 +} deriving (Show, Eq) + +data MemArg = MemArg { + offset :: Int32, + align :: Int32 +} deriving (Show) + +instance Eq MemArg where + (==) memArg1 memArg2 = (offset memArg1) == (offset memArg2) + && (align memArg1) == (align memArg2) + +data BlockType = + EmptyType + | ValType TypeName + | TypeIdx TypeIdx + deriving (Show, Eq) + +data Instruction = + Unreachable + | Nop + | Return + | Call FuncIdx + | I32Const Int32 + | I64Const Int64 + | F32Const Float + | F64Const Double + | I32Load MemArg + | I64Load MemArg + | I32Store MemArg + | I64Store MemArg + | GetLocal LocalIdx + | SetLocal LocalIdx + | GetGlobal GlobalIdx + | SetGlobal GlobalIdx + | I32Add + | I32Sub + | I32And + | I32Mul + | I32Divs + | I32Eqz + | I32Gtu + | I32Leu + | I32Eq + | I32Lts + | I32Gts + | I32Les + | I32Ges + | I32Ne + | LocalTee LocalIdx + | BrIf LabelIdx + | If + | Br LabelIdx + | Block BlockType + | End + | MemorySize + | MemoryGrow + deriving (Eq) + +instance Show Instruction where + show Unreachable = "\n\t\t\t\tunreachable" + show Nop = "\n\t\t\t\tnop" + show Return = "\n\t\t\t\treturn" + show (Call idx) = "\n\t\t\t\tcall " ++ (show idx) + show (I32Const value) = "\n\t\t\t\ti32.const " ++ (show value) + show (I64Const value) = "\n\t\t\t\ti64.const " ++ (show value) + show (F32Const value) = "\n\t\t\t\tf32.const " ++ (show value) + show (F64Const value) = "\n\t\t\t\tf64.const " ++ (show value) + show (I32Load memArg) = "\n\t\t\t\ti32.load " ++ (show memArg) + show (I64Load memArg) = "\n\t\t\t\ti64.load " ++ (show memArg) + show (I32Store memArg) = "\n\t\t\t\ti32.store " ++ (show memArg) + show (I64Store memArg) = "\n\t\t\t\ti64.store " ++ (show memArg) + show (GetLocal idx) = "\n\t\t\t\tget_local " ++ (show idx) + show (SetLocal idx) = "\n\t\t\t\tset_local " ++ (show idx) + show (GetGlobal idx) = "\n\t\t\t\tget_global " ++ (show idx) + show (SetGlobal idx) = "\n\t\t\t\tset_global " ++ (show idx) + show I32Add = "\n\t\t\t\ti32.add" + show I32Sub = "\n\t\t\t\ti32.sub" + show I32Mul = "\n\t\t\t\ti32.mul" + show I32Divs = "\n\t\t\t\ti32.div_s" + show MemorySize = "\n\t\t\t\tmemory.size" + show MemoryGrow = "\n\t\t\t\tmemory.grow" + show I32And = "\n\t\t\t\ti32.and" + show I32Eqz = "\n\t\t\t\ti32.eqz" + show I32Gts = "\n\t\t\t\ti32.gt_s" + show I32Les = "\n\t\t\t\ti32.le_s" + show I32Ne = "\n\t\t\t\ti32.ne" + show I32Ges = "\n\t\t\t\ti32.ge_s" + show I32Lts = "\n\t\t\t\ti32.lt_s" + show I32Gtu = "\n\t\t\t\ti32.gt_u" + show I32Leu = "\n\t\t\t\ti32.le_u" + show If = "\n\t\t\t\tif" + show I32Eq = "\n\t\t\t\ti32.eq" + show (LocalTee idx) = "\n\t\t\t\tlocal.tee " ++ (show idx) + show (BrIf idx) = "\n\t\t\t\tbr_if " ++ (show idx) + show (Br idx) = "\n\t\t\t\tbr " ++ (show idx) + show End = "\n\t\t\t\tend" + show (Block blockType) = "\n\t\t\t\tblock " ++ (show blockType) + +-- Module section + +data Value = + I_32 Int32 + | I_64 Int64 + | F_32 Float + | F_64 Double + deriving (Eq) + +data SectionID = + CustomID + | TypeID + | ImportID + | FunctionID + | TableID + | MemoryID + | GlobalID + | ExportID + | StartID + | ElementID + | CodeID + | DataID + | DataCountID + | InvalidID + deriving (Show, Eq) + +instance Show Value where + show (I_32 val) = show val + show (I_64 val) = show val + show (F_32 val) = show val + show (F_64 val) = show val + +data Local = Local { + lcIdx :: LocalIdx, + lcType :: TypeName +} deriving (Show) + +data FuncType = FuncType { + typeId :: TypeIdx, + params :: [TypeName], + results :: [TypeName] +} deriving (Show) + +data Import = Import { + mod :: String, + name :: String, + desc :: ImportDesc +} deriving (Show) + +data ImportDesc = + ImportFunc TypeIdx | + ImportMemory Limit + deriving (Show) + +data Function = Function { + funcType :: TypeIdx, + funcIdx :: FuncIdx, + locals :: [Local], + body :: [Instruction] +} deriving (Show) + +data Mutability = Const | Var deriving (Show) + +data Global = Global { + globalType :: TypeName, + mutability :: Mutability, + initExpr :: [Instruction] +} deriving (Show) + +data ExportDesc = + ExportFunc FuncIdx + | ExportTable TableIdx + | ExportMemory MemIdx + | ExportGlobal GlobalIdx + deriving (Show) + +data Export = Export { + expName :: String, + expDesc :: ExportDesc +} deriving (Show) + +data Table = Table { + notImpl :: String +} deriving (Show) + +data ModHeader = ModHeader { + magicNumber :: BSL.ByteString, + version :: BSL.ByteString +} deriving (Show) + +data Section = Section { + identifier :: SectionID, + size :: Int, + content :: BSL.ByteString +} deriving (Show) + +data WasmModule = WasmModule { + header :: ModHeader, + types :: [FuncType], + imports :: [Import], + functions :: [Function], + tables :: [Table], + memory :: Memory, + globals :: [Global], + exports :: [Export] +} + +instance Show WasmModule where + show wasmMod = "\n[ Wasm Module Header ]\n" ++ + "- Header: " ++ (show $ header wasmMod) ++ "\n" ++ + "- Types: " ++ (show $ types wasmMod) ++ "\n" ++ + "- Imports: " ++ (show $ imports wasmMod) ++ "\n" ++ + "- Functions: " ++ (show $ functions wasmMod) ++ "\n" ++ + "- Tables: " ++ (show $ tables wasmMod) ++ "\n" ++ + "- Memory: " ++ (show $ memory wasmMod) ++ "\n" ++ + "- Globals: " ++ (show $ globals wasmMod) ++ "\n" ++ + "- Exports: " ++ (show $ exports wasmMod) ++ "\n" + +getTypeFromByte :: Word8 -> TypeName +getTypeFromByte 0x7f = I32 +getTypeFromByte 0x7e = I64 +getTypeFromByte 0x7d = F32 +getTypeFromByte 0x7c = F64 +getTypeFromByte _ = throw $ WasmError "GetTypeFromByte: bad type" diff --git a/lvtrun/stack.yaml b/lvtrun/stack.yaml index b2997b7..c49e528 100644 --- a/lvtrun/stack.yaml +++ b/lvtrun/stack.yaml @@ -40,7 +40,9 @@ packages: # - git: https://github.com/commercialhaskell/stack.git # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a # -# extra-deps: [] +extra-deps: + - bytestring-0.12.0.2 + - binary-0.8.9.1 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/lvtrun/stack.yaml.lock b/lvtrun/stack.yaml.lock index a39a124..9f9dca0 100644 --- a/lvtrun/stack.yaml.lock +++ b/lvtrun/stack.yaml.lock @@ -3,7 +3,21 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: [] +packages: +- completed: + hackage: bytestring-0.12.0.2@sha256:9fc077ff5b7ed2246773c3ac4370ef8822e4834d4587522b68ae551a5968fb86,7891 + pantry-tree: + sha256: 05b5b3ef529f137062c632c38d9c94482ee25bcc0438d51a4be5448dafe690c9 + size: 4355 + original: + hackage: bytestring-0.12.0.2 +- completed: + hackage: binary-0.8.9.1@sha256:81f468c1c75fd6535152ab69b2d32ac6cfcc03e345267b069abe4da56ec95801,6523 + pantry-tree: + sha256: 956ecd662408f69615977b87a92e042abcdc447b7824b8aabf5788c4393c10c5 + size: 1976 + original: + hackage: binary-0.8.9.1 snapshots: - completed: sha256: e176944bc843f740e05242fa7a66ca1f440c127e425254f7f1257f9b19add23f diff --git a/lvtrun/test/HexFile b/lvtrun/test/HexFile new file mode 100644 index 0000000..0e10ef8 Binary files /dev/null and b/lvtrun/test/HexFile differ diff --git a/lvtrun/test/addition.wasm b/lvtrun/test/addition.wasm new file mode 100644 index 0000000..c973627 Binary files /dev/null and b/lvtrun/test/addition.wasm differ diff --git a/lvtrun/test/conditionReturn5.wasm b/lvtrun/test/conditionReturn5.wasm new file mode 100644 index 0000000..fc7866d Binary files /dev/null and b/lvtrun/test/conditionReturn5.wasm differ diff --git a/lvtrun/test/factorial.wasm b/lvtrun/test/factorial.wasm new file mode 100644 index 0000000..013c6a1 Binary files /dev/null and b/lvtrun/test/factorial.wasm differ diff --git a/lvtrun/test/simple.wasm b/lvtrun/test/simple.wasm new file mode 100644 index 0000000..8c85cc0 Binary files /dev/null and b/lvtrun/test/simple.wasm differ diff --git a/lvtrun/test/test.cpp b/lvtrun/test/test.cpp new file mode 100644 index 0000000..87eb861 --- /dev/null +++ b/lvtrun/test/test.cpp @@ -0,0 +1,10 @@ +int add(int a, int b) { + int one = a; + int two = b; + return one + two; +} + +int main() +{ + return add(10, 5); +}