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 ()