Add while

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

docs/BNF.md

@@ -27,7 +27,7 @@
 <parameter> ::= <identifier> ": " <type>
 <type> ::= <upperLetter> <char2>
 <instruction> ::= <instructionIns> ";\n"
-<instructionIns> ::= <declaration> | <assignment> | <functionCall> | <return> | <condition>
+<instructionIns> ::= <declaration> | <assignment> | <functionCall> | <return> | <condition> | <while>
 <declaration> ::= "@" <type> " " <identifier> " = " <value>
 <assignment> ::= <identifier> " = " <value>
 <functionCall> ::= <identifier> "(" <varParamList>* ")"
@@ -39,6 +39,7 @@
 <conditionIfElse> ::= <conditionIf> <conditionElse>
 <conditionIf> ::= "if (" <value> ")\n{\n" <instruction>* "}\n"
 <conditionElse> ::= "else\n{\n" <instruction>* "}\n"
+<while> ::= "while (" <value> ")\n{\n" <instruction>* "}\n"
 
 <character> ::= "'" <char1> "'"
 <bool> ::= "True" | "False"

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

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)

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

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

lvtc/src/WatAST.hs

@@ -41,6 +41,8 @@ data OpCode =
     | If IfType
     | Else
     | End
+    | Loop IfType
+    | Br Int32
     deriving (Show, Eq)
 
 data Type =

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

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

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

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;
 };