diff --git a/book.toml b/book.toml index c40f347..9725d91 100644 --- a/book.toml +++ b/book.toml @@ -1,7 +1,7 @@ [book] -title = "Koaky (Yet Another Programming Language)" +title = "Leviator (Yet Another Programming Language)" authors = ["@Saverio976", "@TTENSHII", "@guillaumeAbel"] -description = "Documentation of Koaky" +description = "Documentation of Leviator" src = "docs" [build] @@ -10,8 +10,8 @@ create-missing = false use-default-preprocessors = true [output.html] -git-repository-url = "https://github.com/X-R-G-B/koak" -edit-url-template = "https://github.com/X-R-G-B/koak/edit/main/{path}" +git-repository-url = "https://github.com/X-R-G-B/Leviator" +edit-url-template = "https://github.com/X-R-G-B/Leviator/edit/main/{path}" [output.html.search] enable = true diff --git a/docs/BNF.md b/docs/BNF.md index 1434673..fa144da 100644 --- a/docs/BNF.md +++ b/docs/BNF.md @@ -27,7 +27,7 @@ ::= ": " ::= ::= ";\n" - ::= | | | | + ::= | | | | | ::= "@" " " " = " ::= " = " ::= "(" * ")" @@ -39,6 +39,7 @@ ::= ::= "if (" ")\n{\n" * "}\n" ::= "else\n{\n" * "}\n" + ::= "while (" ")\n{\n" * "}\n" ::= "'" "'" ::= "True" | "False" diff --git a/lvtc/src/AST.hs b/lvtc/src/AST.hs index 16a6e80..bf071fd 100644 --- a/lvtc/src/AST.hs +++ b/lvtc/src/AST.hs @@ -18,6 +18,7 @@ module AST , Condition , Symbol , IsFuncExport + , WhileBlock ) where import Data.Int (Int32) @@ -77,12 +78,15 @@ type VarDeclaration = (Var, Value) type VarAssignation = (Symbol, Value) +type WhileBlock = (Value, [Instruction]) + data Instruction = Function FuncCall | Return Value | Declaration VarDeclaration | Assignation VarAssignation | Cond Condition + | While WhileBlock instance Show Instruction where show (Function x) = @@ -95,6 +99,8 @@ instance Show Instruction where "Assignation[< " ++ show x ++ " >]" show (Cond x) = "Cond[< " ++ show x ++ " >]" + show (While x) = + "While[< " ++ show x ++ " >]" instance Eq Instruction where (==) (Function x) (Function y) = x == y diff --git a/lvtc/src/Lexeme.hs b/lvtc/src/Lexeme.hs index f102d87..083d301 100644 --- a/lvtc/src/Lexeme.hs +++ b/lvtc/src/Lexeme.hs @@ -66,6 +66,8 @@ 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 ('w':'h':'i':'l':'e':' ':xs) = lexeme 0 ('w':'h':'i':'l':'e':xs) +lexeme 0 (' ':'w':'h':'i':'l':'e':xs) = lexeme 0 ('w':'h':'i':'l':'e':xs) lexeme 0 ('\\':x:xs) = x : lexeme 0 xs lexeme 1 ('\\':x:xs) = x : lexeme 1 xs lexeme 0 (' ':' ':xs) = lexeme 0 (' ':xs) diff --git a/lvtc/src/ParseLvt.hs b/lvtc/src/ParseLvt.hs index c93fa17..74e6667 100644 --- a/lvtc/src/ParseLvt.hs +++ b/lvtc/src/ParseLvt.hs @@ -24,6 +24,7 @@ module ParseLvt parseDeclaration, parseAssignation, parseCond, + parseWhile, -- Function parseFuncDeclaration ) where @@ -269,9 +270,19 @@ parseCond = Parser f Nothing -> Nothing Just (ifBlock, ys) -> runParser (parseCond' val ifBlock) ys +parseWhileComp :: Parser Value +parseWhileComp = parseString "while(" *> parseValue <* parseString ")" + +parseWhileBlock :: Parser [Instruction] +parseWhileBlock = parseString "{" *> parseInstructions <* parseString "}" + +parseWhile :: Parser Instruction +parseWhile = While <$> ((,) <$> parseWhileComp <*> parseWhileBlock) + parseInstruction :: Parser Instruction parseInstruction = (parseCond + <|> parseWhile <|> parseReturn <|> parseDeclaration <|> parseAssignation diff --git a/lvtc/src/WasmUtils.hs b/lvtc/src/WasmUtils.hs index 07be5e2..f8fd87b 100644 --- a/lvtc/src/WasmUtils.hs +++ b/lvtc/src/WasmUtils.hs @@ -181,6 +181,8 @@ getSizeOpCode (LocalSet _) = 2 getSizeOpCode (I32Const _) = 2 getSizeOpCode (Call _) = 2 getSizeOpCode (If _) = 2 +getSizeOpCode (Loop _) = 2 +getSizeOpCode (Br _) = 2 getSizeOpCode _ = 1 fillBlankCodeSectionCode :: CodeSectionCode -> CodeSectionCode @@ -254,6 +256,8 @@ opCodeByte (Call _) = 0x10 opCodeByte (If EmptyType) = 0x04 opCodeByte Else = 0x05 opCodeByte End = 0x0b +opCodeByte (Loop EmptyType) = 0x03 +opCodeByte (Br _) = 0x0c ifTypeByte :: IfType -> Int ifTypeByte EmptyType = 0x40 diff --git a/lvtc/src/WatAST.hs b/lvtc/src/WatAST.hs index 91b353b..98cee4f 100644 --- a/lvtc/src/WatAST.hs +++ b/lvtc/src/WatAST.hs @@ -41,6 +41,8 @@ data OpCode = | If IfType | Else | End + | Loop IfType + | Br Int32 deriving (Show, Eq) data Type = diff --git a/lvtc/src/WatLike.hs b/lvtc/src/WatLike.hs index 0306fc3..2c9d5b8 100644 --- a/lvtc/src/WatLike.hs +++ b/lvtc/src/WatLike.hs @@ -74,6 +74,12 @@ modifyAll' x varsIndex funcsIndex = (x, varsIndex, funcsIndex) --- +transformType :: Type -> Type +transformType "Void" = "Int" +transformType "Char" = "Int" +transformType "Bool" = "Int" +transformType x = x + modifyAll :: [Instruction] -> [Index] -> [Index] -> ([Instruction], [Index], [Index]) modifyAll [] varsIndex funcsIndex = ([], varsIndex, funcsIndex) @@ -119,12 +125,13 @@ modifyAll ((Cond (vValue, insIf, insElse)):xs) 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 +modifyAll ((While (vValue, ins)):xs) vsInd fsInd = + (newWhile:ins', vsInd''', fsInd''') + where + (vValue', vsInd', fsInd') = modifyAll' vValue vsInd fsInd + (insWhile, vsInd'', fsInd'') = modifyAll ins vsInd' fsInd' + newWhile = While (vValue', insWhile) + (ins', vsInd''', fsInd''') = modifyAll xs vsInd'' fsInd'' registerParams :: FuncDeclare -> FuncDeclare registerParams (((isExp, fName, [], typ), ins), varsIndex, oName) = @@ -237,7 +244,7 @@ instructionToWatLike (varsIndex', ins' ++ [newDeclaration]) where (varsIndex', ins', vValue') = valueToWatLike vValue oldFuncs varsIndex - newDeclaration = Declaration ((vName, vTyp), vValue') + newDeclaration = Declaration ((vName, transformType vTyp), vValue') instructionToWatLike (Assignation (vName, vValue)) oldFuncs varsIndex = (varsIndex', ins' ++ [newAssignation]) @@ -266,6 +273,13 @@ instructionToWatLike (vsInd''', vInsFalse') = instructionsToWatLike vInsFalse oldFuncs vsInd'' newCond = Cond (vValCond', vInsTrue', vInsFalse') +instructionToWatLike + (While (vValCond, vIns)) oldFuncs vsInd = + (vsInd'', insCond ++ [newWhile]) + where + (vsInd', insCond, vValCond') = valueToWatLike vValCond oldFuncs vsInd + (vsInd'', vIns') = instructionsToWatLike vIns oldFuncs vsInd' + newWhile = While (vValCond', vIns' ++ insCond) instructionsToWatLike :: [Instruction] -> ([FuncDeclare], [Index]) -> [Index] -> ([Index], [Instruction]) diff --git a/lvtc/src/WatLikeToWat.hs b/lvtc/src/WatLikeToWat.hs index 5279a04..e0ce686 100644 --- a/lvtc/src/WatLikeToWat.hs +++ b/lvtc/src/WatLikeToWat.hs @@ -39,6 +39,8 @@ findTypeFromInstructions name ((Declaration ((name', typ), _)):xs) | otherwise = findTypeFromInstructions name xs findTypeFromInstructions name ((Cond (_, insIf, insElse)):xs) = findTypeFromInstructions name (insIf ++ insElse ++ xs) +findTypeFromInstructions name ((While (_, ins)):xs) = + findTypeFromInstructions name (ins ++ xs) findTypeFromInstructions name (_:xs) = findTypeFromInstructions name xs varsToDecl :: [Index] -> [Instruction] -> [Var] -> [(WatAST.Type, Int32)] @@ -76,43 +78,47 @@ valueToWat _ = error "value not supported" valuesToWat :: [Value] -> [OpCode] valuesToWat = concatMap valueToWat -instructionToWat :: Instruction -> [OpCode] -instructionToWat (AST.Return (Var indexName)) = +instructionToWat :: Instruction -> Int32 -> [OpCode] +instructionToWat (AST.Return (Var indexName)) _ = [ LocalGet (read indexName :: Int32) , WatAST.Return ] -instructionToWat (AST.Return _) = error "Return need a var" -instructionToWat (Declaration ((indexName, _), val)) = +instructionToWat (AST.Return _) _ = error "Return need a var" +instructionToWat (Declaration ((indexName, _), val)) _ = valueToWat val - ++ [ - LocalSet (read indexName :: Int32) - ] -instructionToWat (Assignation (indexName, val)) = + ++ [ LocalSet (read indexName :: Int32) ] +instructionToWat (Assignation (indexName, val)) _ = valueToWat val - ++ [ - LocalSet (read indexName :: Int32) - ] -instructionToWat (Function (indexName, values)) = + ++ [ LocalSet (read indexName :: Int32) ] +instructionToWat (Function (indexName, values)) _ = valuesToWat values - ++ [ - Call (read indexName :: Int32) - ] -instructionToWat (Cond (value, ifTrue, [])) = + ++ [ Call (read indexName :: Int32) ] +instructionToWat (Cond (value, ifTrue, [])) n = + valueToWat value + ++ [ If EmptyType ] ++ ins ++ [ End ] + where + ins = instructionsToWat ifTrue (n + 1) +instructionToWat (Cond (value, ifTrue, ifFalse)) n = valueToWat value - ++ [ If EmptyType ] - ++ instructionsToWat ifTrue - ++ [ End ] -instructionToWat (Cond (value, ifTrue, ifFalse)) = + ++ [ If EmptyType ] ++ insT ++ [ Else ] ++ insF ++ [ End ] + where + insT = instructionsToWat ifTrue (n + 1) + insF = instructionsToWat ifFalse (n + 1) +instructionToWat (While (value, ins)) n = valueToWat value - ++ [ If EmptyType ] - ++ instructionsToWat ifTrue - ++ [ Else ] - ++ instructionsToWat ifFalse - ++ [ End ] + ++ [ If EmptyType, Loop EmptyType ] + ++ ins' ++ valueToWat value ++ [ If EmptyType, Br (n + 1), End] + ++ [ End, End ] + where + ins' = instructionsToWat ins (n + 2) -instructionsToWat :: [Instruction] -> [OpCode] -instructionsToWat = concatMap instructionToWat +instructionsToWat :: [Instruction] -> Int32 -> [OpCode] +instructionsToWat [] _ = [] +instructionsToWat (x:xs) n = ins ++ inss + where + ins = instructionToWat x n + inss = instructionsToWat xs n -- -- instructionsToWat = foldr ((++) . instructionToWat) [] -- @@ -130,7 +136,7 @@ watLikeToWat (((isExp, fName, params, returnType), ins), vars, originName) pType = paramsToTypes params rType = typeStringToType returnType vDecl = groupVarsToDecl $ varsToDecl vars ins params - opcodes = instructionsToWat ins + opcodes = instructionsToWat ins 0 watsLikeToWat :: [FuncDeclare] -> [FuncDef] watsLikeToWat = map watLikeToWat diff --git a/lvtc/src/WriteWasm.hs b/lvtc/src/WriteWasm.hs index 8182161..7f8dd67 100644 --- a/lvtc/src/WriteWasm.hs +++ b/lvtc/src/WriteWasm.hs @@ -125,6 +125,10 @@ opCodeToByte (Call a) = B.pack [fromIntegral (opCodeByte (Call a)), fromIntegral a] opCodeToByte (If a) = B.pack [fromIntegral (opCodeByte (If a)), fromIntegral (ifTypeByte a)] +opCodeToByte (Br a) = + B.pack [fromIntegral (opCodeByte (Br a)), fromIntegral a] +opCodeToByte (Loop a) = + B.pack [fromIntegral (opCodeByte (Loop a)), fromIntegral (ifTypeByte a)] opCodeToByte op = B.pack [fromIntegral (opCodeByte op)] codeSectionCodeToByte :: CodeSectionCode -> B.ByteString diff --git a/lvtc/test/lvt/Test.lvt b/lvtc/test/lvt/Test.lvt index cb0a607..2681727 100644 --- a/lvtc/test/lvt/Test.lvt +++ b/lvtc/test/lvt/Test.lvt @@ -1,14 +1,8 @@ -fn factorial(n: Int) -> Int +export fn start() -> Char { - @Int a = n - 1; - if (a == 0) - { - <- 1; - }; - <- n * factorial(a); -}; - -export fn start() -> Int -{ - <- factorial(5); + @Int a = 0 + 1; + @Int b = a - 1; + @Int c = a * b; + @Int d = c / a; + <- d; };