Improve call instruction interpreter

app/VirtualMachine.hs

@@ -93,13 +93,17 @@ instructions = [ Simple  { _op = Nop,  _noParams = 0, _noPops = 0, _sAction = (\
                ]
 
 call :: VM -> Params -> Pops -> ExceptT String IO VM
-call vm (addr:_) _ = except $ return $ vm { _pc = addr, _fp = fp', _stack = stack' }
-  where
-    fp = _fp vm
-    stack = _stack vm
-    fp' = length stack
-    retAddr = _pc vm + 2
-    stack' = S.fromList [retAddr, fp] <> stack
+call vm (addr:_) _ = except $ return $ flip execState vm $ do  
+  fp  <- getFp
+  fp' <- getStackSize  
+  retAddr  <- getPc >>= return . (+2)
+  
+  push [retAddr, fp]
+  setPc addr
+  setFp fp'  
+  
+  return ()
+
 call _ [] _ = except $ Left $ "Address excepted"
 
 ret :: VM -> Params -> Pops -> ExceptT String IO VM
@@ -157,15 +161,31 @@ getAt index err = do
     (Just i) -> return i
     Nothing  -> except $ Left err
 
+getPc :: State VM Int
+getPc = get >>= (return . _pc)
+
+getFp :: State VM Int
+getFp = get >>= (return . _fp)
+
+getStackSize :: State VM Int
+getStackSize = get >>= (return . length . _stack)
+
+setPc :: Int -> State VM ()
+setPc pc' = do
+  vm <- get
+  put vm { _pc = pc' }
+
+setFp :: Int -> State VM ()
+setFp fp' = do
+  vm <- get
+  put vm { _fp = fp' }
+
 forward :: Int -> State VM () 
 forward offset = do
   vm <- get
   put vm { _pc = _pc vm + offset }
   return ()  
 
-getPc :: State VM Int
-getPc = get >>= (return . _pc)
-
 --------------------------------------------------------------------------
 
 instructionByOp :: M.Map Op Instruction