From 1e7a2d779e20d4d6d73aa766ee68bd0a359a2fcd Mon Sep 17 00:00:00 2001 From: Xavier Mitault Date: Wed, 10 Jan 2024 13:31:38 +0100 Subject: [PATCH] Add wat --- lvtc/lvtc.cabal | 3 + lvtc/src/Builtins.hs | 65 ++++++++++++++++++- lvtc/src/WatAST.hs | 59 +++++++++++++++++ lvtc/src/WatLikeToWat.hs | 134 +++++++++++++++++++++++++++++++++++++++ lvtc/test/Spec.hs | 4 +- lvtc/test/UTWat.hs | 50 +++++++++++++++ lvtc/test/UTWatLike.hs | 45 ++++++++++--- 7 files changed, 347 insertions(+), 13 deletions(-) create mode 100644 lvtc/src/WatAST.hs create mode 100644 lvtc/src/WatLikeToWat.hs create mode 100644 lvtc/test/UTWat.hs diff --git a/lvtc/lvtc.cabal b/lvtc/lvtc.cabal index c2f388d..a3ec115 100644 --- a/lvtc/lvtc.cabal +++ b/lvtc/lvtc.cabal @@ -34,7 +34,9 @@ library Parser ParseUtil ShuntingYard + WatAST WatLike + WatLikeToWat other-modules: Paths_lvtc autogen-modules: @@ -66,6 +68,7 @@ test-suite lvtc-test other-modules: UTParseLvt UTShuntingYard + UTWat UTWatLike Paths_lvtc autogen-modules: diff --git a/lvtc/src/Builtins.hs b/lvtc/src/Builtins.hs index 387c7fc..cb7984e 100644 --- a/lvtc/src/Builtins.hs +++ b/lvtc/src/Builtins.hs @@ -8,15 +8,76 @@ module Builtins ( getBuiltinsFunc + , isBuiltinsFunc + , getBuiltinsWat + , getBuiltinWat ) where +import Text.Read (readMaybe) + import AST +import WatAST -getBuiltinsFunc :: [FuncDeclaration] -getBuiltinsFunc = +getBuiltinsFuncOperator :: [FuncDeclaration] +getBuiltinsFuncOperator = [ (("+", [("x", "Int"), ("y", "Int")], "Int"), []), (("-", [("x", "Int"), ("y", "Int")], "Int"), []), (("*", [("x", "Int"), ("y", "Int")], "Int"), []), (("/", [("x", "Int"), ("y", "Int")], "Int"), []) ] + +getBuiltinsFuncComp :: [FuncDeclaration] +getBuiltinsFuncComp = + [ + (("==", [("x", "Int"), ("y", "Int")], "Int"), []), + (("<", [("x", "Int"), ("y", "Int")], "Int"), []), + ((">", [("x", "Int"), ("y", "Int")], "Int"), []), + (("<=", [("x", "Int"), ("y", "Int")], "Int"), []), + ((">=", [("x", "Int"), ("y", "Int")], "Int"), []), + (("!=", [("x", "Int"), ("y", "Int")], "Int"), []) + ] + +getBuiltinsFunc :: [FuncDeclaration] +getBuiltinsFunc = getBuiltinsFuncOperator ++ getBuiltinsFuncComp + +getStackRet :: [OpCode] -> [OpCode] +getStackRet op = [LocalGet 0, LocalGet 1] ++ op ++ [WatAST.Return] + +getBuiltinsWatOperator :: [FuncDef] +getBuiltinsWatOperator = + [ + FuncDef 0 [I32, I32] I32 (getStackRet [I32Add]) [], + FuncDef 1 [I32, I32] I32 (getStackRet [I32Sub]) [], + FuncDef 2 [I32, I32] I32 (getStackRet [I32Mul]) [], + FuncDef 3 [I32, I32] I32 (getStackRet [I32Div]) [] + ] + +getBuiltinsWatComp :: [FuncDef] +getBuiltinsWatComp = [ + FuncDef 4 [I32, I32] I32 (getStackRet [I32EQ]) [], + FuncDef 5 [I32, I32] I32 (getStackRet [I32LT_S]) [], + FuncDef 6 [I32, I32] I32 (getStackRet [I32GT_S]) [], + FuncDef 7 [I32, I32] I32 (getStackRet [I32LE_S]) [], + FuncDef 8 [I32, I32] I32 (getStackRet [I32GE_S]) [], + FuncDef 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/WatAST.hs b/lvtc/src/WatAST.hs new file mode 100644 index 0000000..6f7e11e --- /dev/null +++ b/lvtc/src/WatAST.hs @@ -0,0 +1,59 @@ +{- +-- EPITECH PROJECT, 2023 +-- Leviator compiler +-- File description: +-- ShuntingYard +-} + +module WatAST +( + OpCode (..) + , Type (..) + , FuncDef (..) +) where + +import Data.Int (Int32) + +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 + | 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 Int32 [Type] Type [OpCode] [(Type, Int32)] + +instance Show FuncDef where + show (FuncDef indexName paramsType returnType bodyCode vars) = + show indexName ++ "(" ++ show paramsType ++ ") -> " ++ show returnType + ++ " {\n" ++ show bodyCode ++ "\n}\n" ++ show vars + +instance Eq FuncDef where + (==) (FuncDef a b c d e) (FuncDef a' b' c' d' e') = + a == a' && b == b' && c == c' && d == d' && e == e' diff --git a/lvtc/src/WatLikeToWat.hs b/lvtc/src/WatLikeToWat.hs new file mode 100644 index 0000000..1272d84 --- /dev/null +++ b/lvtc/src/WatLikeToWat.hs @@ -0,0 +1,134 @@ +{- +-- 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 _ [] = error "Type not found" +findTypeFromInstructions name ((Declaration ((name', typ), _)):xs) + | name == name' = typeStringToType typ + | otherwise = findTypeFromInstructions name 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 ] + ++ instructionsToWat ifTrue + ++ [ End ] +instructionToWat (Cond (value, ifTrue, ifFalse)) = + valueToWat value + ++ [ If ] + ++ 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 (((fName, params, returnType), ins), vars) + | isBuiltinsFunc fName = getBuiltinWat fName + | otherwise = FuncDef indexName paramType retType opcodes varsDecl + where + indexName = read fName :: Int32 + paramType = paramsToTypes params + retType = typeStringToType returnType + varsDecl = groupVarsToDecl $ varsToDecl vars ins params + opcodes = instructionsToWat ins + +watsLikeToWat :: [FuncDeclare] -> [FuncDef] +watsLikeToWat = map watLikeToWat diff --git a/lvtc/test/Spec.hs b/lvtc/test/Spec.hs index 2693713..b57160c 100644 --- a/lvtc/test/Spec.hs +++ b/lvtc/test/Spec.hs @@ -15,6 +15,7 @@ import Alias import UTParseLvt import UTShuntingYard import UTWatLike +import UTWat main :: IO () main = defaultMain tests @@ -27,7 +28,8 @@ tests = testGroup "Leviator Tests - Compiler" utParserLvt, utShuntingYard, utAlias, - utWatLike + utWatLike, + utWat ] testParserHelper :: String -> String -> Expression -> IO () diff --git a/lvtc/test/UTWat.hs b/lvtc/test/UTWat.hs new file mode 100644 index 0000000..a871306 --- /dev/null +++ b/lvtc/test/UTWat.hs @@ -0,0 +1,50 @@ +{- +-- 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) + ] + where + basic1 = builtinsWatLike ++ [ + ( + ( + ("10", [], "Int"), + [ + Declaration (("0", "Int"), Integer 97), + AST.Return (Var "0") + ] + ), + [(0, "_tmpValue")] + ) + ] + basic1_rep = getBuiltinsWat ++ [ + FuncDef 10 [] I32 [ + I32Const 97, + LocalSet 0, + LocalGet 0, + WatAST.Return + ] [(I32, 1)] + ] diff --git a/lvtc/test/UTWatLike.hs b/lvtc/test/UTWatLike.hs index f0085d2..91d9739 100644 --- a/lvtc/test/UTWatLike.hs +++ b/lvtc/test/UTWatLike.hs @@ -7,6 +7,7 @@ module UTWatLike ( utWatLike + , builtinsWatLike ) where import Test.Tasty @@ -15,8 +16,8 @@ import Test.Tasty.HUnit import WatLike import AST -builtinsWat :: [FuncDeclare] -builtinsWat = +builtinsWatLike :: [FuncDeclare] +builtinsWatLike = [ ( (("0", [("0", "Int"), ("1", "Int")], "Int"), []), @@ -33,6 +34,30 @@ builtinsWat = ( (("3", [("0", "Int"), ("1", "Int")], "Int"), []), [(0, "x"), (1, "y")] + ), + ( + (("4", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")] + ), + ( + (("5", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")] + ), + ( + (("6", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")] + ), + ( + (("7", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")] + ), + ( + (("8", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")] + ), + ( + (("9", [("0", "Int"), ("1", "Int")], "Int"), []), + [(0, "x"), (1, "y")] ) ] @@ -59,10 +84,10 @@ utWatLike = testGroup "Wat Like" [Return (FuncValue ("+", [Var "a", Var "b"]))] ) basic1_rep = - builtinsWat ++ [ + builtinsWatLike ++ [ ( ( - ("4", [("0", "Int"), ("1", "Int")], "Int"), + ("10", [("0", "Int"), ("1", "Int")], "Int"), [ Declaration (("2", "Int"), FuncValue ("0", [Var "0", Var "1"])), Return (Var "2") @@ -83,10 +108,10 @@ utWatLike = testGroup "Wat Like" ) ] basic2_rep = - builtinsWat ++ [ + builtinsWatLike ++ [ ( ( - ("4", [("0", "Int"), ("1", "Int")], "Int"), + ("10", [("0", "Int"), ("1", "Int")], "Int"), [ Declaration (("2", "Int"), FuncValue ("0", [Var "0", Var "1"])), Return (Var "2") @@ -96,11 +121,11 @@ utWatLike = testGroup "Wat Like" ), ( ( - ("5", [], "Int"), + ("11", [], "Int"), [ Declaration (("0", "Int"), Integer 1), Declaration (("1", "Int"), Integer 2), - Declaration (("2", "Int"), FuncValue ("4", [Var "0", Var "1"])), + Declaration (("2", "Int"), FuncValue ("10", [Var "0", Var "1"])), Return (Var "2") ] ), @@ -113,10 +138,10 @@ utWatLike = testGroup "Wat Like" [Return (Character 'a')] ) basic3_rep = - builtinsWat ++ [ + builtinsWatLike ++ [ ( ( - ("4", [], "Int"), + ("10", [], "Int"), [ Declaration (("0", "Int"), Integer 97), Return (Var "0")