Pop.hs

module Language.Melody.Interpret.Pop (
  push,
  pop,
  topN,
  popWord,
  popFunc,
  popDict,
  popList,
  popNum,
  popStr,
  popBoxed) where
import Language.Melody.Interpret.Types
import Language.Melody.Syntax
import Control.Monad.Error
import Control.Lens

errorMsg :: String -> Expr Compiled -> MelodyM a
errorMsg s e = throwError . TypeMismatch $ "Expected " ++ s ++ " got " ++ show e

push :: Expr NotCompiled -> Melody
push = (stack %=) . (:)

pop :: MelodyM (Expr Compiled)
pop = do
  h <- use (stack.to headMay)
  case h of
    Just x -> stack %= tail >> return x
    Nothing -> lift . throwError $ UnderflowError "Somewhere"
  where headMay []    = Nothing
        headMay (c:_) = Just c

popWord :: MelodyM String
popWord = do
  h <- pop
  case h of
    Word w -> return w
    e      -> errorMsg "word" e

popFunc :: MelodyM (Expr NotCompiled, Maybe Closure)
popFunc = do
  f <- pop
  case f of
    Func exprs clos -> return (exprs, clos)
    e               -> errorMsg "func" e

popDict :: MelodyM [(Expr Compiled, Expr Compiled)]
popDict = do
  h <- pop
  case h of
    Dictionary d   -> return d
    e              -> errorMsg "hash" e

popList :: MelodyM [Expr Compiled]
popList = do
  h <- pop
  case h of
    List w -> return w
    e      -> errorMsg "list" e

popNum :: MelodyM Double
popNum = do
  h <- pop
  case h of
    NumLit n -> return n
    e        -> errorMsg "num" e

popStr :: MelodyM String
popStr = do
  h <- pop
  case h of
    StrLit n -> return n
    e        -> errorMsg "str" e

popBoxed :: MelodyM (String, String, [Expr Compiled])
popBoxed = do
  b <- pop
  case b of
    Boxed t c es -> return (t, c, es)
    e            -> errorMsg "boxed" e

topN :: Int -> MelodyM [Expr Compiled]
topN = flip replicateM pop