Add wat

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:

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

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'

lvtc/src/WatLike.hs

@@ -212,7 +212,7 @@ valueToWatLike (Character x) _ varsIndex =
         (varsIndex', indVar) = newIndex varsIndex
         ordChar = read (show (ord x)) :: Int32
         newDeclaration = Declaration ((show indVar, "Int"), Integer ordChar)
-valueToWatLike (StringView _) _ _ = undefined
+valueToWatLike (StringView _) _ _ = error "StringView not implemented for now"
 valueToWatLike Void _ varsIndex =
     (varsIndex', [newDeclaration], Var (show indVar))
     where

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 name [] = error ("Type not found for: " ++ name)
+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

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 ()