Interpret.hs

{-# LANGUAGE TupleSections #-}
module Language.Melody.Interpret (eval, runMelody, Melody) where
import Control.Lens
import Data.List (nub)
import Control.Monad.Error
import Language.Melody.Interpret.Env
import Language.Melody.Interpret.Types
import Language.Melody.Interpret.Compile
import Language.Melody.Interpret.Pop
import Language.Melody.Syntax
import Control.Monad.Reader
import qualified Data.Map as M

-- | Generate constructors for a given type. This creates
-- a new word for each constructor
generateConstrs :: TypeName -> [(Constructor, Int)] -> [(String, Melody)]
generateConstrs t = map makeConstr
  where makeConstr (name, arity) = (name, replicateM arity pop >>= push . Boxed t name)

-- | Run a given expression in an environment with no local variables
emptyEnv :: Melody -> Melody
emptyEnv = local (const M.empty)

-- | Evaluate a @TopLevel@. If it is an expression it runs it,
-- otherwise it generates the appropriate bindings for definitions.
eval :: TopLevel -> Melody
eval (Def nm expr) = env.at nm .= Just (emptyEnv $ compile expr)
eval (Exec expr)   = compile expr
eval (Type t cs)   = assertUnique (map fst cs) >> env %= M.union (M.fromList $ generateConstrs t cs)
  where assertUnique names = when (length names /= length (nub names))
                             . throwError . Misc $ "Constructors are not unique for " ++ t
eval (MultiDef t) = multi.at t .= Just []
eval (MultiExt t args body) = multi.at t._Just %= (:) (args, emptyEnv $ compile body)

-- | Turn a @Melody@ expression into an @IO@ expression
runMelody :: Melody -> IO (Either EvalError [Expr Compiled])
runMelody = getStack $ unwrapMelody (M.fromList []) defaultEnv
  where getStack = mapped.mapped._Right %~ view stack