From d52f3e4b66c22fd29797fdffe6a44ebbe5f9fdd4 Mon Sep 17 00:00:00 2001 From: Aldric Date: Sun, 14 Jan 2024 23:39:49 +0100 Subject: [PATCH] feat: factorial --- LobsterLang/app/Main.hs | 2 +- LobsterLang/fnv | Bin 0 -> 63 bytes LobsterLang/src/Compiler.hs | 61 +++++++++++++++++++++++++++------ LobsterLang/src/CompiletoVm.hs | 17 +++++++-- LobsterLang/src/Vm.hs | 4 +-- ded | 0 define_fnv | Bin 0 -> 44 bytes exemple/Cond.lob | 4 +++ exemple/Factorial.lob | 2 ++ exemple/Factorial.lobo | Bin 0 -> 121 bytes exemple/Fibonacci.lob | 4 ++- exemple/Fibonacci.lobo | Bin 0 -> 173 bytes exemple/Neg.lob | 2 ++ exemple/Neg.lobo | Bin 0 -> 57 bytes exemple/test.lob | 7 ++++ exemple/test.lobo | Bin 0 -> 52 bytes output2.lobo | Bin 0 -> 52 bytes 17 files changed, 86 insertions(+), 17 deletions(-) create mode 100644 LobsterLang/fnv create mode 100644 ded create mode 100644 define_fnv create mode 100644 exemple/Cond.lob create mode 100644 exemple/Factorial.lobo create mode 100644 exemple/Fibonacci.lobo create mode 100644 exemple/Neg.lobo create mode 100644 exemple/test.lob create mode 100644 exemple/test.lobo create mode 100644 output2.lobo diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index e3630a2..17c6940 100644 --- a/LobsterLang/app/Main.hs +++ b/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) diff --git a/LobsterLang/fnv b/LobsterLang/fnv new file mode 100644 index 0000000000000000000000000000000000000000..e9f52c14b8da2d8a8aa95e053c937912c7670800 GIT binary patch literal 63 zcmZQzVEV1Wz`($qn34jd7&UB%B$EJ$-~kdK4O-d&qt*n( literal 0 HcmV?d00001 diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index 01fce18..a230e7c 100644 --- a/LobsterLang/src/Compiler.hs +++ b/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 diff --git a/LobsterLang/src/CompiletoVm.hs b/LobsterLang/src/CompiletoVm.hs index 0b645a5..bec6bbf 100644 --- a/LobsterLang/src/CompiletoVm.hs +++ b/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]) diff --git a/LobsterLang/src/Vm.hs b/LobsterLang/src/Vm.hs index 871b696..f3eb32c 100644 --- a/LobsterLang/src/Vm.hs +++ b/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 diff --git a/ded b/ded new file mode 100644 index 0000000..e69de29 diff --git a/define_fnv b/define_fnv new file mode 100644 index 0000000000000000000000000000000000000000..e7f6329f65c4a88e6e81d910e193b318cb08b595 GIT binary patch literal 44 jcmdO3U|?WQOi2M!jG91#3B*VQ5lKLTnFq`TlSxJZP5J{^ literal 0 HcmV?d00001 diff --git a/exemple/Cond.lob b/exemple/Cond.lob new file mode 100644 index 0000000..9dd52df --- /dev/null +++ b/exemple/Cond.lob @@ -0,0 +1,4 @@ +x = 5 +if x == 0 {| + 0 +|} \ No newline at end of file diff --git a/exemple/Factorial.lob b/exemple/Factorial.lob index 63d5ee3..eaf8ad3 100644 --- a/exemple/Factorial.lob +++ b/exemple/Factorial.lob @@ -5,3 +5,5 @@ fn factorial(| x |) {| x * factorial(| x - 1 |) |} |} + +factorial(| 5 |) \ No newline at end of file diff --git a/exemple/Factorial.lobo b/exemple/Factorial.lobo new file mode 100644 index 0000000000000000000000000000000000000000..e3ce399d0c7b1ebae749fa4a057f3e894762ebc3 GIT binary patch literal 121 zcmZQzVEV1Wz`($nmY7_UUzC}c1LQDjf(Rhy=K>N8{2;6Kuf(y(7%NT>1 UJU~H&AzEM=6K#+bD>iv;06XLkx&QzG literal 0 HcmV?d00001 diff --git a/exemple/Fibonacci.lob b/exemple/Fibonacci.lob index c76026a..96181cf 100644 --- a/exemple/Fibonacci.lob +++ b/exemple/Fibonacci.lob @@ -1,5 +1,5 @@ fn fibonacci(| x |) {| - if true {| + if x == 0 {| 0 |} else if x == 1 {| 1 @@ -7,3 +7,5 @@ fn fibonacci(| x |) {| fibonacci(| x - 1 |) + fibonacci(| x - 2 |) |} |} + +fibonacci(| 5 |) \ No newline at end of file diff --git a/exemple/Fibonacci.lobo b/exemple/Fibonacci.lobo new file mode 100644 index 0000000000000000000000000000000000000000..04bed8c0ecc4c5f4ecd80ad4e3fceec488f4ea64 GIT binary patch literal 173 zcmZQzVEV1Wz`($nmYI~FmzbQK3FI(pf(Rg%;{p;4{2;rq}a3pzP<*H literal 0 HcmV?d00001