feat: factorial

LobsterLang/app/Main.hs

@@ -72,7 +72,7 @@ compileFile file s = case runParser parseLobster (0, 0) s of
 checkArgs :: [String] -> IO ()
 checkArgs [] = print "Launch Interpreter" >> inputLoop []
 checkArgs ("-e":file:_) = CompiletoVm.makeConvert file
-                        >>= \instructions -> trace (show instructions) print (Vm.exec 0 [] [] instructions [])
+                        >>= \instructions -> trace ("instructions to execute" ++ show instructions) print (Vm.exec 0 [] [] instructions [])
 checkArgs (file:_) = either
                         (\_ -> print "File doesn't exist" >> exitWith (ExitFailure 84))
                         (compileFile file)

LobsterLang/src/Compiler.hs

@@ -25,6 +25,7 @@ import qualified Data.ByteString.UTF8 as BSUTF8
 import Data.Binary
 import Data.Binary.Put
 import qualified Data.List
+import Debug.Trace (trace)
 
 data CompileConstants = Null
   | MagicNumber deriving (Show, Eq)
@@ -183,7 +184,7 @@ astToInstructions (Symbol symbolName (Just symbolArgs)) =
       map astToInstructions symbolArgs
 astToInstructions (String stringValue) = [PushStr stringValue]
 astToInstructions (List values) =
-  [PushList (length valuesInstructions) valuesInstructions]
+  [PushList (_findAstInstrSize values) valuesInstructions]
   where
     valuesInstructions = map astToInstructions values
 astToInstructions (AST.Call "+" args) =
@@ -231,27 +232,29 @@ astToInstructions (AST.Call "~" args) =
 astToInstructions (AST.Call _ _) = [NoOp]
 astToInstructions (Define symbolName value) =
   let symbolValue = astToInstructions value
-  in [Def symbolName (length symbolValue) symbolValue]
+  in [Def symbolName 1 symbolValue]
 astToInstructions (FunctionValue argsNames funcBody Nothing) =
   [ Fnv
     (length argsNames)
     argsNames
-    (length funcBodyInstructions)
+    nbFuncBodyInstructions
     funcBodyInstructions
     []
     Nothing ]
   where
+    nbFuncBodyInstructions = _findAstInstrSize [funcBody]
     funcBodyInstructions =
       _resolveFunctionPushArgs (astToInstructions funcBody ++ [Ret]) argsNames
 astToInstructions (FunctionValue argsNames funcBody (Just argsValues)) =
   [ Fnv
     (length argsNames)
     argsNames
-    (length funcBodyInstructions)
+    nbFuncBodyInstructions
     funcBodyInstructions
     nbArgsValuesInstructions
     argsValuesInstructions ]
   where
+    nbFuncBodyInstructions = _findAstInstrSize [funcBody]
     funcBodyInstructions =
       _resolveFunctionPushArgs (astToInstructions funcBody ++ [Ret]) argsNames
     argsValuesInstructions =
@@ -267,8 +270,8 @@ astToInstructions (AST.Cond cond trueBlock (Just falseBlock)) =
     condInstructions = astToInstructions cond
     falseBlockInstructions = astToInstructions falseBlock
     trueBlockInstructions =
-      astToInstructions trueBlock ++ [Jump (length falseBlockInstructions)]
-    nbTrueBlockInstructions = length trueBlockInstructions
+      astToInstructions trueBlock ++ [Jump (_findAstInstrSize [falseBlock] + 1)]
+    nbTrueBlockInstructions = _findAstInstrSize [trueBlock] + 1
 astToInstructions (AST.Cond cond trueBlock Nothing) =
   [ Compiler.Cond
     condInstructions
@@ -279,7 +282,7 @@ astToInstructions (AST.Cond cond trueBlock Nothing) =
     condInstructions = astToInstructions cond
     trueBlockInstructions =
       astToInstructions trueBlock
-    nbTrueBlockInstructions = length trueBlockInstructions
+    nbTrueBlockInstructions = _findAstInstrSize [trueBlock] + 1
 
 _showInstruction :: Instruction -> Int -> [Char]
 _showInstruction NoOp _ = "NO_OP\n"
@@ -411,15 +414,53 @@ _showInstruction Len depth =
 
 _resolveFunctionPushArgs :: [Instruction] -> [String] -> [Instruction]
 _resolveFunctionPushArgs [] _ = []
-_resolveFunctionPushArgs [PushSym symbolName args] argsNames =
+_resolveFunctionPushArgs [PushSym symbolName Nothing] argsNames =
   case Data.List.elemIndex symbolName argsNames of
     Just value -> [PushArg value]
-    Nothing -> [PushSym symbolName args]
+    Nothing -> [PushSym symbolName Nothing]
+_resolveFunctionPushArgs [PushSym symbolName (Just args)] argsNames =
+  case Data.List.elemIndex symbolName argsNames of
+    Just value -> [PushArg value]
+    Nothing -> [PushSym symbolName (Just (fmap (`_resolveFunctionPushArgs` argsNames) args))]
+_resolveFunctionPushArgs [Compiler.Cond condInstructions
+  nbTrueBlockInstructions trueBlockInstructions
+  (Just falseBlockInstructions)] argsNames = trace (show (_resolveFunctionPushArgs falseBlockInstructions argsNames))
+    [ Compiler.Cond
+    (_resolveFunctionPushArgs condInstructions argsNames)
+    nbTrueBlockInstructions
+    (_resolveFunctionPushArgs trueBlockInstructions argsNames)
+    (Just (_resolveFunctionPushArgs falseBlockInstructions argsNames))]
+_resolveFunctionPushArgs [Compiler.Cond condInstructions
+  nbTrueBlockInstructions trueBlockInstructions Nothing] argsNames =
+    [ Compiler.Cond
+    (_resolveFunctionPushArgs condInstructions argsNames)
+    nbTrueBlockInstructions
+    (_resolveFunctionPushArgs trueBlockInstructions argsNames)
+    Nothing]
+_resolveFunctionPushArgs [PushList nbValuesInstructions valuesInstructions]
+  argsNames =
+  [PushList nbValuesInstructions
+    (fmap (`_resolveFunctionPushArgs` argsNames) valuesInstructions)]
 _resolveFunctionPushArgs [instruction] _ = [instruction]
 _resolveFunctionPushArgs (instruction:instructions) argsNames
   = _resolveFunctionPushArgs [instruction] argsNames
   ++ _resolveFunctionPushArgs instructions argsNames
 
+_findAstInstrSize :: [Ast] -> Int
+_findAstInstrSize [] = 0
+_findAstInstrSize (Value _:xs) = 1 + _findAstInstrSize xs
+_findAstInstrSize (Boolean _:xs) = 1 + _findAstInstrSize xs
+_findAstInstrSize (String _:xs) = 1 + _findAstInstrSize xs
+_findAstInstrSize (Define _ ast:xs) = 1 + _findAstInstrSize [ast] + _findAstInstrSize xs
+_findAstInstrSize (List asts:xs) = 1 + _findAstInstrSize asts + _findAstInstrSize xs
+_findAstInstrSize (Symbol _ Nothing:xs) = 1 + _findAstInstrSize xs
+_findAstInstrSize (Symbol _ (Just asts):xs) = _findAstInstrSize asts + 4 + _findAstInstrSize xs-- push nbGivenArgs, pushSym, Call
+_findAstInstrSize (AST.Call _ asts:xs) = _findAstInstrSize asts + 1 + _findAstInstrSize xs
+_findAstInstrSize (FunctionValue _ ast Nothing:xs) = _findAstInstrSize [ast] + 2 + _findAstInstrSize xs
+_findAstInstrSize (FunctionValue _ ast (Just asts):xs) = _findAstInstrSize asts + 1 + _findAstInstrSize [ast] + 3 + _findAstInstrSize xs
+_findAstInstrSize (AST.Cond astCond astTrue Nothing:xs) = _findAstInstrSize [astCond] + 1 + _findAstInstrSize [astTrue] + _findAstInstrSize xs
+_findAstInstrSize (AST.Cond astCond astTrue (Just astFalse):xs) = _findAstInstrSize [astCond] + 1 + _findAstInstrSize [astTrue] + 1 + _findAstInstrSize [astFalse] + _findAstInstrSize xs
+
 _instructionListLengths :: Maybe [[Instruction]] -> [Int]
 _instructionListLengths (Just []) = [0]
 _instructionListLengths (Just [instructionList]) = [length instructionList]
@@ -604,5 +645,5 @@ compile ast filepath showInst = if showInst
     >> writeCompiledInstructionsToFile filepath compiledInstructions
   else writeCompiledInstructionsToFile filepath compiledInstructions
   where
-    instructions = concatMap astToInstructions ast ++ [Ret]
+    instructions = trace (show ast) concatMap astToInstructions ast ++ [Ret]
     compiledInstructions = _putInt32 (fromEnum MagicNumber) >> _fputList _compileInstruction instructions

LobsterLang/src/CompiletoVm.hs

@@ -13,6 +13,7 @@ import qualified Data.ByteString.Lazy as BIN
 import GHC.Int
 import Vm
 import Compiler
+import Debug.Trace (trace)
 
 makeConvert :: String -> IO Inst
 makeConvert path = BIN.readFile path >>= \filepath -> case (decodeOrFail filepath :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
@@ -79,6 +80,7 @@ convert file inst = case (decodeOrFail file :: Either (BIN.ByteString, ByteOffse
             Compiler.GreatEq -> convert remainingfile (inst ++ [Vm.Push (Op Vm.GreatEq), Vm.Call])
             Compiler.And -> convert remainingfile (inst ++ [Vm.Push (Op Vm.And), Vm.Call])
             Compiler.Or ->convert remainingfile (inst ++ [Vm.Push (Op Vm.Or), Vm.Call])
+            Compiler.XorB -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Xorb)])
             Compiler.Not -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Not), Vm.Call])
             Compiler.ToStr -> convert remainingfile (inst ++ [Vm.Push (Op Vm.ToString), Vm.Call])
             Compiler.Apnd -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Append), Vm.Call])
@@ -111,7 +113,7 @@ getFnv (-1) byteString inst = case (decodeOrFail byteString :: Either (BIN.ByteS
                 byteStringafterNbInst = case (decodeOrFail nByteString :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
                     Left _ -> nByteString
                     Right (afterNbInst, _, _) -> afterNbInst
-                functionInstruction = fst (getInstructionFunc nbinstruction byteStringafterNbInst [])
+                functionInstruction = trace ("fucntion instruction: " ++ show nbinstruction) fst (getInstructionFunc nbinstruction byteStringafterNbInst [])
                 byteStringAfterInst = snd (getInstructionFunc nbinstruction byteStringafterNbInst [])
 getFnv _ byteString inst = (inst, byteString)
 
@@ -150,7 +152,7 @@ getInstructionFunc 0 byteString inst = (inst, byteString)
 getInstructionFunc nbInstruction byteString inst = case (decodeOrFail byteString :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of
     Left _ -> ([], byteString)
     Right (remainingfile, _, opcode) -> case toEnum (fromIntegral opcode) of
-        PushI _-> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
+        PushI _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
             Left _ -> ([], byteString)
             Right (remfile, _, val) -> getInstructionFunc (nbInstruction - 1) remfile (inst ++ [(Vm.Push (IntVal (fromIntegral (val :: Int32) :: Int)))])
         PushB _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of
@@ -170,6 +172,12 @@ getInstructionFunc nbInstruction byteString inst = case (decodeOrFail byteString
         Compiler.PushArg _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
             Left _ -> ([], remainingfile)
             Right (remfile, _, val) -> getInstructionFunc (nbInstruction - 1) remfile (inst ++ [Vm.PushArg (fromIntegral (val :: Int32) :: Int)])
+        Compiler.Jump _-> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
+            Left _ -> ([], remainingfile)
+            Right (remfile, _, val) -> getInstructionFunc (nbInstruction - 1) remfile (inst ++ [Vm.Jump (fromIntegral (val :: Int32) :: Int)])
+        Compiler.JumpIfFalse _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of
+            Left _ -> ([], remainingfile)
+            Right (remfile, _, val) -> getInstructionFunc (nbInstruction - 1) remfile (inst ++ [Vm.JumpIfFalse (fromIntegral (val :: Int32) :: Int)])
         Compiler.Add ->  getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Add), Vm.Call])
         Compiler.Sub -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Sub), Vm.Call])
         Compiler.Mul -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Mul), Vm.Call])
@@ -182,6 +190,7 @@ getInstructionFunc nbInstruction byteString inst = case (decodeOrFail byteString
         Compiler.GreatEq -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.GreatEq), Vm.Call])
         Compiler.And -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.And), Vm.Call])
         Compiler.Or ->getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Or), Vm.Call])
+        Compiler.XorB -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Xorb)])
         Compiler.Not -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Not), Vm.Call])
         Compiler.ToStr -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.ToString), Vm.Call])
         Compiler.Apnd -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Append), Vm.Call])
@@ -190,7 +199,8 @@ getInstructionFunc nbInstruction byteString inst = case (decodeOrFail byteString
         Compiler.Len -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Len), Vm.Call])
         Compiler.PutArg -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.PutArg])
         Compiler.Ret -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Ret])
-        Compiler.Fnv {} -> getInstructionFunc (nbInstruction - 1) (snd (getFnv (-1) remainingfile [])) (inst ++ (fst (getFnv (-1) remainingfile [])))
+        Compiler.Fnv {} -> trace (show "here") getInstructionFunc (nbInstruction - 1) (snd (getFnv (-1) remainingfile [])) (inst ++ (fst (getFnv (-1) remainingfile [])))
+        Compiler.Call -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Call])
         _ -> (inst, byteString)
 
 getDefinedValue :: Int -> BIN.ByteString -> [Vm.Instruction] -> ([Vm.Instruction], BIN.ByteString)
@@ -230,6 +240,7 @@ getDefinedValue nbInstruction byteString inst = case (decodeOrFail byteString ::
         Compiler.GreatEq -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.GreatEq), Vm.Call])
         Compiler.And -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.And), Vm.Call])
         Compiler.Or ->getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Or), Vm.Call])
+        Compiler.XorB -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Xorb)])
         Compiler.Not -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Not), Vm.Call])
         Compiler.ToStr -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.ToString), Vm.Call])
         Compiler.Apnd -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Append), Vm.Call])

LobsterLang/src/Vm.hs

@@ -371,7 +371,7 @@ exec depth env arg (Call : xs) stack = case Stack.pop stack of
                             (Function (Push v:PutArg:body) (nb - 1)))
                     (Nothing, _) -> (Left "Error: stack is empty 3", env)
             (_, _) -> (Left "Error: stack is invalid for a function call", env)
-        (Just a, _) -> (Left ("Error: not an Operation or a function " ++ show a), env)
+        (Just a, _) -> (Left ("Error: not an Operation or a function " ++ show a ++ "stack : " ++ show stack), env)
 exec _ _ [] (PushArg _:_) _ = (Left "Error: no Arg", [])
 exec depth env arg (PushArg x:xs) stack
     | x < 0 = (Left "Error index out of range", env)
@@ -383,7 +383,7 @@ exec depth env arg (PushList x:xs) stack
     | otherwise = exec depth env arg xs (ListVal (snd (createList x stack [])) : (fst (createList x stack [])))
 exec _ [] _ (PushEnv _:_) _ = (Left "Error: no Env", [])
 exec depth env arg (PushEnv x:xs) stack =  case isInEnv x depth env of
-    Nothing -> (Left "Error: not in environment", env)
+    Nothing -> (Left ("Error: not in environment " ++ x ++ " " ++ show depth), env)
     Just (BoolVal b) -> exec depth env arg  (Push (BoolVal b):xs) stack
     Just (IntVal i) -> exec depth env arg  (Push (IntVal i):xs) stack
     Just (CharVal c) -> exec depth env arg  (Push (CharVal c):xs) stack

exemple/Cond.lob

@@ -0,0 +1,4 @@
+x = 5
+if x == 0 {|
+    0
+|}

exemple/Factorial.lob

@@ -5,3 +5,5 @@ fn factorial(| x |) {|
         x * factorial(| x - 1 |)
     |}
 |}
+
+factorial(| 5 |)

exemple/Fibonacci.lob

@@ -1,9 +1,11 @@
 fn fibonacci(| x |) {|
-    if true {|
+    if x == 0 {|
         0
     |} else if x == 1 {|
         1
     |} else {|
         fibonacci(| x - 1 |) + fibonacci(| x - 2 |)
     |}
 |}
+
+fibonacci(| 5 |)

exemple/Neg.lob

@@ -1,3 +1,5 @@
 fn neg(| x |) {|
     0 - x
 |}
+
+neg(| 5 |)

exemple/test.lob

@@ -0,0 +1,7 @@
+a = 5
+
+if a == 5 {|
+    8
+|} else {|
+    9
+|}