Types.hs

{-# LANGUAGE TemplateHaskell #-}
module Language.Melody.Interpret.Types where
import Language.Melody.Syntax
import Control.Monad.Error
import Control.Monad.State
import Control.Monad.Reader
import Control.Lens
import Data.Monoid
import Data.Map(Map, empty, union)

data EvalError = UnderflowError String
               | TypeMismatch String
               | NoSuchName String
               | Misc String
               deriving (Eq, Show)

instance Error EvalError where
  strMsg = Misc
  noMsg  = Misc "Report this error"



type MelodyM = ReaderT Closure (StateT MelodyState (ErrorT EvalError IO))
-- Since melody is stack based, there's no need for return values
type Melody = MelodyM ()

data MelodyState = MS { _env   :: Map String Melody
                      , _multi :: Map String [([TypeName], Melody)]
                      , _stack :: [Expr Compiled]}

makeLenses ''MelodyState

instance Monoid MelodyState where
  mempty  = MS empty empty []
  mappend (MS env1 multi1 stack1) (MS env2 multi2 stack2) = MS (union env1 env2)
                                                            (union multi1 multi2)
                                                            (stack1 ++ stack2)

unwrapMelody :: Closure -> MelodyState -> Melody -> IO (Either EvalError MelodyState)
unwrapMelody lexVars defaultEnv =
  runErrorT . flip execStateT defaultEnv . flip runReaderT lexVars

typeError :: String -> MelodyM a
typeError = throwError . TypeMismatch