diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 8fbadab..17c6940 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -15,10 +15,13 @@ import System.Environment (getArgs) import qualified AstEval import qualified AstOptimizer import qualified Compiler +import qualified Vm +import qualified CompiletoVm import Control.Exception import qualified AST import AstOptimizer (optimizeAst) +import Debug.Trace lobsterNotHappy :: String -> String -> String -> String lobsterNotHappy color state str = "\ESC[" ++ color ++ "m\ESC[1mThe lobster is " ++ state ++ ": " ++ str ++ "\ESC[0m" @@ -58,7 +61,7 @@ compileInfo :: String -> [AST.Ast] -> [Scope.ScopeMb] -> IO () compileInfo _ [] _ = putStr "" compileInfo filename list stack = checkCompileInfo (optimizeAst stack list False) [] >>= \res -> case sequence res of Left _ -> exitWith (ExitFailure 84) - Right value -> Compiler.compile (map AstOptimizer.fromOptimised value) (filename ++ ".o") True + Right value -> Compiler.compile (map AstOptimizer.fromOptimised value) (filename ++ "o") True compileFile :: String -> String -> IO () compileFile file s = case runParser parseLobster (0, 0) s of @@ -68,6 +71,8 @@ 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 ("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 0000000..e9f52c1 Binary files /dev/null and b/LobsterLang/fnv differ diff --git a/LobsterLang/src/Compiler.hs b/LobsterLang/src/Compiler.hs index fb035fd..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) @@ -180,82 +181,84 @@ astToInstructions (Symbol symbolName (Just symbolArgs)) = [PushSym symbolName (Just symbolArgsInstructions)] where symbolArgsInstructions = - foldr (((:) . \b -> b ++ [PutArg]) . astToInstructions) [] 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) = - concatMap astToInstructions args ++ [Add] + reverse (concatMap astToInstructions args) ++ [Add] astToInstructions (AST.Call "-" args) = - concatMap astToInstructions args ++ [Sub] + reverse (concatMap astToInstructions args) ++ [Sub] astToInstructions (AST.Call "*" args) = - concatMap astToInstructions args ++ [Mul] + reverse (concatMap astToInstructions args) ++ [Mul] astToInstructions (AST.Call "/" args) = - concatMap astToInstructions args ++ [Div] + reverse (concatMap astToInstructions args) ++ [Div] astToInstructions (AST.Call "%" args) = - concatMap astToInstructions args ++ [Mod] + reverse (concatMap astToInstructions args) ++ [Mod] astToInstructions (AST.Call "^^" args) = - concatMap astToInstructions args ++ [XorB] + reverse (concatMap astToInstructions args) ++ [XorB] astToInstructions (AST.Call "==" args) = - concatMap astToInstructions args ++ [Eq] + reverse (concatMap astToInstructions args) ++ [Eq] astToInstructions (AST.Call "!=" args) = - concatMap astToInstructions args ++ [NotEq] + reverse (concatMap astToInstructions args) ++ [NotEq] astToInstructions (AST.Call "<" args) = - concatMap astToInstructions args ++ [Less] + reverse (concatMap astToInstructions args) ++ [Less] astToInstructions (AST.Call "<=" args) = - concatMap astToInstructions args ++ [LessEq] + reverse (concatMap astToInstructions args) ++ [LessEq] astToInstructions (AST.Call ">" args) = - concatMap astToInstructions args ++ [Great] + reverse (concatMap astToInstructions args) ++ [Great] astToInstructions (AST.Call ">=" args) = - concatMap astToInstructions args ++ [GreatEq] + reverse (concatMap astToInstructions args) ++ [GreatEq] astToInstructions (AST.Call "&&" args) = - concatMap astToInstructions args ++ [And] + reverse (concatMap astToInstructions args) ++ [And] astToInstructions (AST.Call "||" args) = - concatMap astToInstructions args ++ [Or] + reverse (concatMap astToInstructions args) ++ [Or] astToInstructions (AST.Call "!" args) = - concatMap astToInstructions args ++ [Not] + reverse (concatMap astToInstructions args) ++ [Not] astToInstructions (AST.Call "$" args) = - concatMap astToInstructions args ++ [Then] + reverse (concatMap astToInstructions args) ++ [Then] astToInstructions (AST.Call "@" args) = - concatMap astToInstructions args ++ [ToStr] + reverse (concatMap astToInstructions args) ++ [ToStr] astToInstructions (AST.Call "++" args) = - concatMap astToInstructions args ++ [Apnd] + reverse (concatMap astToInstructions args) ++ [Apnd] astToInstructions (AST.Call "--" args) = - concatMap astToInstructions args ++ [RemAllOcc] + reverse (concatMap astToInstructions args) ++ [RemAllOcc] astToInstructions (AST.Call "!!" args) = - concatMap astToInstructions args ++ [Get] + reverse (concatMap astToInstructions args) ++ [Get] astToInstructions (AST.Call "~" args) = - concatMap astToInstructions args ++ [Len] + reverse (concatMap astToInstructions args) ++ [Len] 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 = - Just (foldr (((:) . \b -> b ++ [PutArg]) . astToInstructions) [] argsValues) + Just (map astToInstructions argsValues) nbArgsValuesInstructions = _instructionListLengths argsValuesInstructions astToInstructions (AST.Cond cond trueBlock (Just falseBlock)) = [ Compiler.Cond @@ -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] @@ -477,6 +518,7 @@ _compileInstruction (PushSym symbolName Nothing) = >> _putString symbolName _compileInstruction (PushSym symbolName (Just symbolArgs)) = _fputList compileInstructions symbolArgs + >> _putOpCodeFromInstruction (PushI (length symbolArgs)) >> _putInt32 (length symbolArgs) >> _putOpCodeFromInstruction (PushSym symbolName (Just symbolArgs)) >> _putString symbolName >> _putOpCodeFromInstruction Compiler.Call @@ -552,6 +594,7 @@ _compileInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions funcBodyInstructions nbArgsValuesInstructions (Just argsValuesInstructions)) = _fputList compileInstructions argsValuesInstructions + >> _putOpCodeFromInstruction (PushI (length argsValuesInstructions)) >> _putInt32 (length argsValuesInstructions) >> _putOpCodeFromInstruction (Fnv nbArgsNames argsNames nbFuncBodyInstructions funcBodyInstructions nbArgsValuesInstructions @@ -602,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 6c4554b..bec6bbf 100644 --- a/LobsterLang/src/CompiletoVm.hs +++ b/LobsterLang/src/CompiletoVm.hs @@ -13,84 +13,86 @@ 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 -> convert filepath [] +makeConvert path = BIN.readFile path >>= \filepath -> case (decodeOrFail filepath :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (allfile, _, magicNumber) + | (fromIntegral (magicNumber :: Int32) :: Int) == fromEnum MagicNumber -> convert allfile [] + | otherwise -> return [] convert :: BIN.ByteString -> Inst -> IO Inst -convert file inst = case (decodeOrFail file :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return inst - Right (allfile, _, magicNumber) - | (fromIntegral (magicNumber :: Int32) :: Int) == fromEnum MagicNumber -> case (decodeOrFail allfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of - Left _ -> return inst - Right (remainingfile, _, opcode) -> case toEnum (fromIntegral opcode) of - NoOp -> convert remainingfile inst - PushI _-> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, val) -> convert remfile (inst ++ [Push (IntVal (fromIntegral (val :: Int32) :: Int))]) - PushB _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of - Left _ -> return [] - Right (remfile, _, 1) -> convert remfile (inst ++ [Push (BoolVal True)]) - Right (remfile, _, 0) -> convert remfile (inst ++ [Push (BoolVal False)]) - Right (remfile, _, _) -> convert remfile inst - PushStr _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, byteToRead) -> convert (snd (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])) (inst ++ [Push (StringVal (fst (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])))]) - PushSym _ _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, byteToRead) -> convert (snd (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])) (inst ++ [PushEnv (fst (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile []))]) - Compiler.PushArg _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, val) -> convert remfile (inst ++ [Vm.PushArg (fromIntegral (val :: Int32) :: Int)]) - Compiler.Jump _-> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, val) -> convert remfile (inst ++ [Vm.Jump (fromIntegral (val :: Int32) :: Int)]) - Compiler.JumpIfFalse _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, val) -> convert remfile (inst ++ [Vm.JumpIfFalse (fromIntegral (val :: Int32) :: Int)]) - ---------------------------------------------------------------- - Compiler.Def {} -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, val) -> convert reminfile (inst ++ symbolValue ++ symbolName) - where - remainAfterStr = snd (getString (fromIntegral (val :: Int32) :: Int) remfile []) - symbolName = [Vm.Define (fst (getString (fromIntegral (val :: Int32) :: Int) remfile []))] - nbinstructions = case (decodeOrFail remainAfterStr :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> 0 - Right (_ , _, nbinst) -> (fromIntegral (nbinst :: Int32) :: Int) - fileAfternbinst = case (decodeOrFail remainAfterStr :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> remainAfterStr - Right (rema, _, _) -> rema - symbolValue = fst (getDefinedValue nbinstructions fileAfternbinst []) - reminfile = snd (getDefinedValue nbinstructions fileAfternbinst []) - Compiler.Fnv {} -> convert (snd (getFnv (-1) remainingfile [])) (inst ++ fst (getFnv (-1) remainingfile [])) - Compiler.Call -> convert remainingfile (inst ++ [Vm.Call]) - Compiler.Ret -> convert remainingfile (inst ++ [Vm.Ret]) - Compiler.Add -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Add), Vm.Call]) - Compiler.Sub -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Sub), Vm.Call]) - Compiler.Mul -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Mul), Vm.Call]) - Compiler.Div -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Div), Vm.Call]) - Compiler.Mod -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Mod), Vm.Call]) - Compiler.Eq -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Eq), Vm.Call]) - Compiler.Less -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Less), Vm.Call]) - Compiler.LessEq -> convert remainingfile (inst ++ [Vm.Push (Op Vm.LessEq), Vm.Call]) - Compiler.Great -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Great), Vm.Call]) - 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.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]) - Compiler.RemAllOcc -> convert remainingfile (inst ++ [Vm.Push (Op Vm.RmOcc), Vm.Call]) - Compiler.Get -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Get), Vm.Call]) - Compiler.Len -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Len), Vm.Call]) - Compiler.PutArg -> convert remainingfile (inst ++ [Vm.PutArg]) - Compiler.Neg -> convert remainingfile inst - Compiler.PushList _ _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of - Left _ -> return [] - Right (remfile, _, lenList) -> convert (snd (getList (fromIntegral (lenList :: Int32) :: Int) remfile [] )) (inst ++ fst (getList (fromIntegral (lenList :: Int32) :: Int) remfile []) ++ [Vm.PushList (fromIntegral (lenList :: Int32) :: Int)]) - _ -> convert remainingfile inst - Right (_, _, _) -> return inst +convert file inst = case (decodeOrFail file :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of + Left _ -> return inst + Right (remainingfile, _, opcode) -> case toEnum (fromIntegral opcode) of + NoOp -> convert remainingfile inst + PushI _-> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, val) -> convert remfile (inst ++ [Push (IntVal (fromIntegral (val :: Int32) :: Int))]) + PushB _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of + Left _ -> return [] + Right (remfile, _, 1) -> convert remfile (inst ++ [Push (BoolVal True)]) + Right (remfile, _, 0) -> convert remfile (inst ++ [Push (BoolVal False)]) + Right (remfile, _, _) -> convert remfile inst + PushStr _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, byteToRead) -> convert (snd (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])) (inst ++ [Push (StringVal (fst (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])))]) + PushSym _ _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, byteToRead) -> convert (snd (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])) (inst ++ [PushEnv (fst (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile []))]) + Compiler.PushArg _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, val) -> convert remfile (inst ++ [Vm.PushArg (fromIntegral (val :: Int32) :: Int)]) + Compiler.Jump _-> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, val) -> convert remfile (inst ++ [Vm.Jump (fromIntegral (val :: Int32) :: Int)]) + Compiler.JumpIfFalse _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, val) -> convert remfile (inst ++ [Vm.JumpIfFalse (fromIntegral (val :: Int32) :: Int)]) + ---------------------------------------------------------------- + Compiler.Def {} -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, val) -> convert reminfile (inst ++ symbolValue ++ symbolName) + where + remainAfterStr = snd (getString (fromIntegral (val :: Int32) :: Int) remfile []) + symbolName = [Vm.Define (fst (getString (fromIntegral (val :: Int32) :: Int) remfile []))] + nbinstructions = case (decodeOrFail remainAfterStr :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> 0 + Right (_ , _, nbinst) -> (fromIntegral (nbinst :: Int32) :: Int) + fileAfternbinst = case (decodeOrFail remainAfterStr :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> remainAfterStr + Right (rema, _, _) -> rema + symbolValue = fst (getDefinedValue nbinstructions fileAfternbinst []) + reminfile = snd (getDefinedValue nbinstructions fileAfternbinst []) + Compiler.Fnv {} -> convert (snd (getFnv (-1) remainingfile [])) (inst ++ fst (getFnv (-1) remainingfile [])) + Compiler.Call -> convert remainingfile (inst ++ [Vm.Call]) + Compiler.Ret -> convert remainingfile (inst ++ [Vm.Ret]) + Compiler.Add -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Add), Vm.Call]) + Compiler.Sub -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Sub), Vm.Call]) + Compiler.Mul -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Mul), Vm.Call]) + Compiler.Div -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Div), Vm.Call]) + Compiler.Mod -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Mod), Vm.Call]) + Compiler.Eq -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Eq), Vm.Call]) + Compiler.Less -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Less), Vm.Call]) + Compiler.LessEq -> convert remainingfile (inst ++ [Vm.Push (Op Vm.LessEq), Vm.Call]) + Compiler.Great -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Great), Vm.Call]) + 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]) + Compiler.RemAllOcc -> convert remainingfile (inst ++ [Vm.Push (Op Vm.RmOcc), Vm.Call]) + Compiler.Get -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Get), Vm.Call]) + Compiler.Len -> convert remainingfile (inst ++ [Vm.Push (Op Vm.Len), Vm.Call]) + Compiler.PutArg -> convert remainingfile (inst ++ [Vm.PutArg]) + Compiler.Neg -> convert remainingfile inst + Compiler.PushList _ _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + Left _ -> return [] + Right (remfile, _, lenList) -> convert (snd (getList (fromIntegral (lenList :: Int32) :: Int) remfile [] )) (inst ++ fst (getList (fromIntegral (lenList :: Int32) :: Int) remfile []) ++ [Vm.PushList (fromIntegral (lenList :: Int32) :: Int)]) + _ -> convert remainingfile inst getString :: Int -> BIN.ByteString -> String -> (String, BIN.ByteString) getString 0 byteString str = (str, byteString) @@ -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]) @@ -189,7 +198,9 @@ getInstructionFunc nbInstruction byteString inst = case (decodeOrFail byteString Compiler.Get -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Get), Vm.Call]) Compiler.Len -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Len), Vm.Call]) Compiler.PutArg -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.PutArg]) - Compiler.Fnv _ _ _ _ _ _ -> getInstructionFunc (nbInstruction - 1) (snd (getFnv (-1) remainingfile [])) (inst ++ (fst (getFnv (-1) remainingfile []))) + Compiler.Ret -> getInstructionFunc (nbInstruction - 1) remainingfile (inst ++ [Vm.Ret]) + 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) @@ -229,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]) @@ -236,7 +248,8 @@ getDefinedValue nbInstruction byteString inst = case (decodeOrFail byteString :: Compiler.Get -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Get), Vm.Call]) Compiler.Len -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Push (Op Vm.Len), Vm.Call]) Compiler.PutArg -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.PutArg]) - Compiler.Fnv _ _ _ _ _ _ -> getDefinedValue (nbInstruction - 1) (snd (getFnv (-1) remainingfile [])) (inst ++ (fst (getFnv (-1) remainingfile []))) + Compiler.Ret -> getDefinedValue (nbInstruction - 1) remainingfile (inst ++ [Vm.Ret]) + Compiler.Fnv {} -> getDefinedValue (nbInstruction - 1) (snd (getFnv (-1) remainingfile [])) (inst ++ (fst (getFnv (-1) remainingfile []))) _ -> (inst, byteString) getList :: Int -> BIN.ByteString -> [Vm.Instruction] -> ([Vm.Instruction], BIN.ByteString) diff --git a/LobsterLang/src/Vm.hs b/LobsterLang/src/Vm.hs index 130cdc3..f3eb32c 100644 --- a/LobsterLang/src/Vm.hs +++ b/LobsterLang/src/Vm.hs @@ -351,9 +351,9 @@ createList n stack val = case Stack.pop stack of (Just x, stack1) -> createList (n - 1) stack1 (val ++ [x]) exec :: Int -> Env -> Arg -> Inst -> Stack -> (Either String Value, Env) -exec _ _ _ (Call : _) [] = (Left "Error: stack is empty", []) +exec _ _ _ (Call : _) [] = (Left "Error: stack is empty 1", []) exec depth env arg (Call : xs) stack = case Stack.pop stack of - (Nothing, _) -> (Left "Error: stack is empty", env) + (Nothing, _) -> (Left "Error: stack is empty 2", env) (Just (Op x), stack1) -> case makeOperation x stack1 of Left err -> (Left err, env) Right newstack -> exec depth env arg xs newstack @@ -369,9 +369,9 @@ exec depth env arg (Call : xs) stack = case Stack.pop stack of (Stack.push (Stack.push stack3 (IntVal (nb' - 1))) (Function (Push v:PutArg:body) (nb - 1))) - (Nothing, _) -> (Left "Error: stack is empty", env) + (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 @@ -393,11 +393,11 @@ exec depth env arg (PushEnv x:xs) stack = case isInEnv x depth env of Just (ListVal list) -> exec depth env arg (Push (ListVal list):xs) stack exec depth env arg (Push val:xs) stack = exec depth env arg xs (Stack.push stack val) exec depth env arg (PutArg:xs) stack = case Stack.pop stack of - (Nothing, _) -> (Left "Error: stack is empty", env) + (Nothing, _) -> (Left "Error: stack is empty 4", env) (Just val, stack1) -> exec depth env (arg ++ [val]) xs stack1 exec depth env arg (JumpIfFalse val:xs) stack | Prelude.null xs = (Left "Error: no jump possible", env) - | Prelude.null stack = (Left "Error: stack is empty", env) + | Prelude.null stack = (Left "Error: stack is empty 5", env) | val < 0 = (Left "Error: invalid jump value", env) | val > length xs = (Left "Error: invalid jump value", env) | not (isBoolVal (Stack.top stack)) = (Left "Error: not bool", env) @@ -405,7 +405,7 @@ exec depth env arg (JumpIfFalse val:xs) stack | otherwise = exec depth env arg (Prelude.drop val xs) stack exec depth env arg (JumpIfTrue val:xs) stack | Prelude.null xs = (Left "Error: no jump possible", env) - | Prelude.null stack = (Left "Error: stack is empty", env) + | Prelude.null stack = (Left "Error: stack is empty 6", env) | val < 0 = (Left "Error: invalid jump value", env) | val > length xs = (Left "Error: invalid jump value", env) | not (isBoolVal (Stack.top stack)) = (Left "Error: not bool", env) 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 0000000..e7f6329 Binary files /dev/null and b/define_fnv differ 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 0000000..e3ce399 Binary files /dev/null and b/exemple/Factorial.lobo differ diff --git a/exemple/Fibonacci.lob b/exemple/Fibonacci.lob index 5a481d4..96181cf 100644 --- a/exemple/Fibonacci.lob +++ b/exemple/Fibonacci.lob @@ -8,13 +8,4 @@ fn fibonacci(| x |) {| |} |} -fibonacci(| 1 |) -fibonacci(| 2 |) -fibonacci(| 3 |) -fibonacci(| 4 |) -fibonacci(| 5 |) -fibonacci(| 6 |) -fibonacci(| 7 |) -fibonacci(| 8 |) -fibonacci(| 9 |) -fibonacci(| 10 |) +fibonacci(| 5 |) \ No newline at end of file diff --git a/exemple/Fibonacci.lobo b/exemple/Fibonacci.lobo new file mode 100644 index 0000000..04bed8c Binary files /dev/null and b/exemple/Fibonacci.lobo differ diff --git a/exemple/Neg.lob b/exemple/Neg.lob index cfdce51..0f01080 100644 --- a/exemple/Neg.lob +++ b/exemple/Neg.lob @@ -1,3 +1,5 @@ fn neg(| x |) {| 0 - x |} + +neg(| 5 |) diff --git a/exemple/Neg.lobo b/exemple/Neg.lobo new file mode 100644 index 0000000..3315006 Binary files /dev/null and b/exemple/Neg.lobo differ diff --git a/exemple/test.lob b/exemple/test.lob new file mode 100644 index 0000000..01bd4a8 --- /dev/null +++ b/exemple/test.lob @@ -0,0 +1,7 @@ +a = 5 + +if a == 5 {| + 8 +|} else {| + 9 +|} \ No newline at end of file diff --git a/exemple/test.lobo b/exemple/test.lobo new file mode 100644 index 0000000..4c3905d Binary files /dev/null and b/exemple/test.lobo differ diff --git a/output2.lobo b/output2.lobo new file mode 100644 index 0000000..b6c6336 Binary files /dev/null and b/output2.lobo differ