spade-0.1.0.0: src/Interpreter.hs

module Interpreter where

import Prelude hiding (map)

import Control.Concurrent.MVar
import Control.Exception (SomeException, displayException)
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Catch (catch)
import Data.IORef (newIORef)
import Data.Map as M hiding (map)
import Data.Text as T hiding (index, map)

import Compiler.AST.Program
import Control.Monad.State.Strict
import Interpreter.Common
import Interpreter.Initialize
import Interpreter.Interpreter
import Interpreter.Lib.SDL
import UI.Widgets.Common

interpret_ :: TChan TerminalEvent -> Program -> IO InterpreterState
interpret_ teventChan prg = do
  debugIn <- newEmptyMVar
  debugOut <- newEmptyMVar
  sdlWindowsRef <- newIORef []
  let istate = emptyIs sdlWindowsRef debugIn debugOut teventChan
  interpret' (istate { isRunMode = NormalMode })  prg

interpret :: MVar DebugIn -> MVar DebugOut -> TChan TerminalEvent -> Program -> IO InterpreterState
interpret debugIn debugOut teventsChan prg = do
  sdlWindowsRef <- newIORef []
  interpret' (emptyIs sdlWindowsRef debugIn debugOut teventsChan) prg

interpret' :: InterpreterState -> Program -> IO InterpreterState
interpret' istate prg = snd <$> do
  let debugOut = isDebugOut istate
  flip runStateT istate $ catch (do
    loadBuiltIns
    interpretPassOne prg
    interpretPassTwo prg
    cleanupSDL
    liftIO $ putMVar debugOut Finished
    ) (\(e :: SomeException) -> do
      cleanupSDL
      liftIO $ putMVar debugOut (Errored $ T.pack $ displayException e))

interpretPassOne :: Program -> InterpretM ()
interpretPassOne x = mapM_ (\a -> fn a) x
  where
    fn :: ProgramStatement -> InterpretM ()
    fn (FunctionDefStatement fdef@(FunctionDef name _ _)) = modify $ mapGlobalScope $
      \s -> insert (SkIdentifier name) (ProcedureValue fdef) s
    fn _ = pure ()

interpretPassTwo :: Program -> InterpretM ()
interpretPassTwo x = mapM_ (\a -> fn a) x
  where
    fn :: ProgramStatement -> InterpretM ()
    fn (FunctionDefStatement (FunctionDef _ _ _)) = pure ()
    fn (NakedStatement fs)                        = void $ executeStatement fs
    fn (TopLevelComment _)                        = pure ()