finish asm interp

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"
-  
-
-