diff --git a/LobsterLang/src/CompiletoVm.hs b/LobsterLang/src/CompiletoVm.hs index 7b863b5..92c5a21 100644 --- a/LobsterLang/src/CompiletoVm.hs +++ b/LobsterLang/src/CompiletoVm.hs @@ -5,7 +5,7 @@ -- CompiletoVm -} -module CompiletoVm (convert, makeConvert, getString, getList, getDefinedValue) where +module CompiletoVm (convert, makeConvert, getString, getList, getDefinedValue, getInstruction) where import Data.Binary import Data.Binary.Get @@ -14,41 +14,41 @@ import GHC.Int import Vm import Compiler -makeConvert :: String -> IO (Env, Arg, Inst) -makeConvert path = BIN.readFile path >>= \filepath -> convert filepath ([], [], []) +makeConvert :: String -> IO Inst +makeConvert path = BIN.readFile path >>= \filepath -> convert filepath [] -convert :: BIN.ByteString -> (Env, Arg, Inst) -> IO (Env, Arg, Inst) -convert file (env, arg, inst) = case (decodeOrFail file :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of - Left _ -> return (env, arg, inst) +convert :: BIN.ByteString -> Inst -> IO 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 (env, arg, inst) + 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 (env, arg, inst ++ [Push (IntVal (fromIntegral (val :: Int32) :: Int))]) + 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 (env, arg, inst ++ [Push (BoolVal True)]) - Right (remfile, _, 0) -> convert remfile (env, arg, inst ++ [Push (BoolVal False)]) - Right (remfile, _, _) -> convert remfile (env, arg, inst) + 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 [])) (env, arg, inst ++ [Push (StringVal (fst (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile [])))]) + 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 [])) (env, arg, inst ++ [PushEnv (fst (getString (fromIntegral (byteToRead :: Int32) :: Int) remfile []))]) + 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 (env, arg, inst ++ [Vm.PushArg (fromIntegral (val :: Int32) :: Int)]) + 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 (env, arg, inst ++ [Vm.Jump (fromIntegral (val :: Int32) :: Int)]) + 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 (env, arg, inst ++ [Vm.JumpIfFalse (fromIntegral (val :: Int32) :: Int)]) + 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 (env, arg, inst ++ symbolValue ++ symbolName) + 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 []))] @@ -60,32 +60,55 @@ convert file (env, arg, inst) = case (decodeOrFail file :: Either (BIN.ByteStrin Right (rema, _, _) -> rema symbolValue = fst (getDefinedValue nbinstructions fileAfternbinst []) reminfile = snd (getDefinedValue nbinstructions fileAfternbinst []) - -- nbnamearg -> namearg -> nbinstructions -> inst -> nbvalue -> value - -- Compiler.Fnv -> -- fnv - Compiler.Call -> convert remainingfile (env, arg, inst ++ [Vm.Call]) - Compiler.Ret -> convert remainingfile (env, arg, inst ++ [Vm.Ret]) - Compiler.Add -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Add), Vm.Call]) - Compiler.Sub -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Sub), Vm.Call]) - Compiler.Mul -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Mul), Vm.Call]) - Compiler.Div -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Div), Vm.Call]) - Compiler.Mod -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Mod), Vm.Call]) - Compiler.Eq -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Eq), Vm.Call]) - Compiler.Less -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Less), Vm.Call]) - Compiler.LessEq -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.LessEq), Vm.Call]) - Compiler.Great -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Great), Vm.Call]) - Compiler.GreatEq -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.GreatEq), Vm.Call]) - Compiler.And -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.And), Vm.Call]) - Compiler.Or ->convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Or), Vm.Call]) - Compiler.Not -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Not), Vm.Call]) - Compiler.ToStr -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.ToString), Vm.Call]) - Compiler.Apnd -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Append), Vm.Call]) - Compiler.RemAllOcc -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.RmOcc), Vm.Call]) - Compiler.Get -> convert remainingfile (env, arg, inst ++ [Vm.Push (Op Vm.Get), Vm.Call]) - Compiler.Neg -> convert remainingfile (env, arg, inst) + -- -- nbnamearg -> namearg -> nbinstructions -> inst -> nbvalue -> value + -- Compiler.Fnv _ _ _ _ _ _ -> case (decodeOrFail remainingfile :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + -- Left _ -> return [] + -- Right (rema, _, val) -> convert fileremaining (inst ++ putArg ++ [Vm.Push (Vm.Function functionInstruction (fromIntegral (val :: Int32) :: Int))] ++ call) + -- where + -- nbinst = case (decodeOrFail rema :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + -- Left _ -> 0 + -- Right (_, _, ninst) -> (fromIntegral (ninst :: Int32) :: Int) + -- fileAfternInst = case (decodeOrFail rema :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + -- Left _ -> rema + -- Right (remain, _, _) -> remain + -- fileAfterInst = snd (getInstruction nbinst fileAfternInst []) + -- functionInstruction = fst (getInstruction nbinst fileAfternInst []) + -- nbputarg = case (decodeOrFail fileAfterInst :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + -- Left _ -> 0 + -- Right (_, _, narg) -> (fromIntegral (narg :: Int32) :: Int) + -- fileAfternarg = case (decodeOrFail fileAfterInst :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Int32)) of + -- Left _ -> fileAfterInst + -- Right (fileremain, _, _) -> fileremain + -- call | nbputarg <= (-1) = [] + -- | otherwise = [Vm.Call] + -- putArg | nbputarg <= 0 = [] + -- | + -- fileremaining = -- reste du fichier + ------------------------------- + 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.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 [] )) (env, arg, inst ++ (fst (getList (fromIntegral (lenList :: Int32) :: Int) remfile [])) ++ [(Vm.PushList (fromIntegral (lenList :: Int32) :: Int))]) - _ -> convert remainingfile (env, arg, inst) + 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) @@ -93,6 +116,9 @@ getString nbytes byteString s = case (decodeOrFail byteString :: Either (BIN.Byt Right (remainingfile, _, a) -> getString (nbytes - 1) remainingfile (s ++ [a]) Left _ -> (s, byteString) +getInstruction :: Int -> BIN.ByteString -> [Vm.Instruction] -> ([Vm.Instruction], BIN.ByteString) +getInstruction 0 byteString inst = (inst, byteString) + getDefinedValue :: Int -> BIN.ByteString -> [Vm.Instruction] -> ([Vm.Instruction], BIN.ByteString) getDefinedValue 0 byteString inst = (inst, byteString) getDefinedValue nbInstruction byteString inst = case (decodeOrFail byteString :: Either (BIN.ByteString, ByteOffset, String) (BIN.ByteString, ByteOffset, Word8)) of