diff options
Diffstat (limited to '2-kyu/assembler-interpreter.hs')
| -rw-r--r-- | 2-kyu/assembler-interpreter.hs | 152 |
1 files changed, 131 insertions, 21 deletions
diff --git a/2-kyu/assembler-interpreter.hs b/2-kyu/assembler-interpreter.hs index a7a6bb7..b3887e6 100644 --- a/2-kyu/assembler-interpreter.hs +++ b/2-kyu/assembler-interpreter.hs @@ -1,3 +1,4 @@ +-- https://www.codewars.com/kata/58e61f3d8ff24f774400002c module AssemblerInterpreter where import Debug.Trace @@ -12,9 +13,6 @@ import Control.Monad.Trans.Maybe import Control.Monad.Trans.State import Control.Monad.Trans.Class(lift) -interpret :: String -> Maybe String -interpret prog = Nothing - type Parser = Parsec String () data Op = @@ -22,8 +20,11 @@ data Op = Jge | Jg | Jle | Jl | Call | Ret | Msg | End deriving (Show) +stringP :: String -> Parser String +stringP str = try $ string str + opStrP :: Parser String -opStrP = choice $ map string' [ +opStrP = choice $ map stringP [ "mov", "inc", "dec", "add", "sub", "mul", "div", "jmp", "cmp", "jne", "je", "jge", "jg", "jle", "jl", "call", "ret", "msg", "end"] @@ -81,7 +82,16 @@ argP :: Parser Arg argP = do inlineSpaces let identifierArgP = IdentifierArg <$> identifierP - numberP = NumberArg . read <$> many1 digit + numberP = do + negSign <- optionMaybe $ char '-' + let isNeg = case negSign of + Just _ -> True + Nothing -> False + digits <- many1 digit + let n :: Int = read digits + return $ NumberArg $ if isNeg then + negate n + else n stringP = do oneOf ['\''] :: Parser Char str <- many $ noneOf ['\''] @@ -161,6 +171,7 @@ data MachineState = MachineState , machineOutput :: Maybe String , machineProg :: [Stmt] , machineLabels :: M.Map String Int + , machineCmpFlag :: Ordering , machineEnd :: Bool } deriving (Show) @@ -194,6 +205,20 @@ getReg r = do Just n -> return n Nothing -> fail [] +machinePush :: Int -> MachineM () +machinePush n = do + ms <- lift get + let stack = machineStack ms + lift $ put ms {machineStack = n:stack} + +machinePop :: MachineM Int +machinePop = do + ms <- lift get + case machineStack ms of + [] -> fail [] + (x:xs) -> do + lift $ put ms {machineStack = xs} + return x execInstr :: Stmt -> MachineM () execInstr (InstrStmt op args) = decodeOp op args @@ -216,10 +241,12 @@ runMachine = do Just stmt -> do execInstr stmt ; runMachine execMov :: [Arg] -> MachineM () -execMov [IdentifierArg reg, NumberArg n] = do setReg reg n +execMov [IdentifierArg reg, NumberArg n] = do + setReg reg n + nextInstr execMov [IdentifierArg r1, IdentifierArg r2] = do - n <- getReg r1 - setReg r2 n + n <- getReg r2 + setReg r1 n nextInstr execMov _ = fail [] @@ -240,13 +267,105 @@ execEnd :: [Arg] -> MachineM () execEnd [] = do ms <- lift get lift $ put ms { machineEnd = True } -execEdn _ = fail [] +execEnd _ = fail [] + +execInc :: [Arg] -> MachineM() +execInc [IdentifierArg r] = do + n <- getReg r + setReg r (n+1) + nextInstr +execInc _ = fail [] + +execDec :: [Arg] -> MachineM() +execDec [IdentifierArg r] = do + n <- getReg r + setReg r (n-1) + nextInstr +execDec _ = fail [] + +execArithmetic :: (Int->Int->Int) -> [Arg] -> MachineM () +execArithmetic op [IdentifierArg ra, IdentifierArg rb] = do + n <- getReg rb + execArithmetic op [IdentifierArg ra, NumberArg n] +execArithmetic op [IdentifierArg r, NumberArg n] = do + x <- getReg r + setReg r (op x n) + nextInstr +execArithmetic _ _ = fail [] + +execAdd = execArithmetic (+) +execSub = execArithmetic (-) +execMul = execArithmetic (*) +execDiv = execArithmetic div + +machineGoto :: Int -> MachineM () +machineGoto p = do + ms <- lift get + lift $ put ms {machineProgCnt = p} + +execJmp :: [Arg] -> MachineM () +execJmp [IdentifierArg lbl] = do + ms <- lift get + let labelMap = machineLabels ms + case M.lookup lbl labelMap of + Just pos -> machineGoto pos + Nothing -> fail [] +execJmp _ = fail [] + +execCmp :: [Arg] -> MachineM () +execCmp [IdentifierArg r1, a2] = do + n1 <- getReg r1 + execCmp [NumberArg n1, a2] +execCmp [a1, IdentifierArg r2] = do + n2 <- getReg r2 + execCmp [a1, NumberArg n2] +execCmp [NumberArg n1, NumberArg n2] = do + ms <- lift get + lift $ put ms { machineCmpFlag = compare n1 n2 } + nextInstr + +execCondJmp :: [Ordering] -> [Arg] -> MachineM () +execCondJmp conds [IdentifierArg lbl] = do + flag <- machineCmpFlag <$> lift get + if flag `elem` conds then execJmp [IdentifierArg lbl] + else nextInstr +execCondJmp conds _ = fail [] + +execCall :: [Arg] -> MachineM () +execCall [arg@(IdentifierArg lbl)] = do + ms <- lift get + let p = machineProgCnt ms + 1 + machinePush p + execJmp [arg] + +execRet :: [Arg] -> MachineM () +execRet [] = do + n <- machinePop + machineGoto n +execRet _ = fail [] decodeOp :: Op -> [Arg] -> MachineM () decodeOp Mov = execMov +decodeOp Inc = execInc +decodeOp Dec = execDec +decodeOp Add = execAdd +decodeOp Sub = execSub +decodeOp Mul = execMul +decodeOp Div = execDiv +decodeOp Jmp = execJmp +decodeOp Cmp = execCmp +decodeOp Jl = execCondJmp [LT] +decodeOp Jg = execCondJmp [GT] +decodeOp Je = execCondJmp [EQ] +decodeOp Jge = execCondJmp [EQ, GT] +decodeOp Jle = execCondJmp [EQ, LT] +decodeOp Jne = execCondJmp [GT, LT] +decodeOp Call = execCall +decodeOp Ret = execRet decodeOp Msg = execMsg decodeOp End = execEnd + buildMachine :: String -> Maybe MachineState buildMachine code = let @@ -263,23 +382,14 @@ buildMachine code = , machineOutput = Nothing , machineProg = stmts , machineProgCnt = 0 + , machineCmpFlag = EQ , machineStack = [] } _ -> Nothing -interp :: String -> Maybe String -interp code = do +interpret :: String -> Maybe String +interpret code = do ms <- buildMachine code let (res, _) = runState (runMaybeT runMachine) ms res - -main = do - print $ runParser opP () "" "msg" - print $ runParser stmtLineP () "" "ret" - print $ runParser progP () "" "ret \n mov a , 12\n uwu: \n ret" - print $ runParser progP () "" "ret ; 123 ; 123\n mov a , 12\n uwu: \n ret" - print $ interp "msg \'hello\'\n end" - - - |