{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

module Earthling.Eval where

import qualified Data.Foldable as F
import           Data.Sequence (Seq)
import qualified Data.Sequence as S
import           Data.Text (Text)

import           Earthling.Types

eval :: Seq (Decl 'Raw) -> IO ()
eval decls = case F.find (\ d -> declName d == "main") decls of
  Nothing -> putStrLn "no main defined"
  Just d  -> do
    _ <- runInstrs decls (S.viewl (declDefn d)) []
    return ()

data Value
  = IntValue Integer
  | DoubleValue Double
    deriving (Eq, Show)

runInstrs :: Seq (Decl 'Raw) -> S.ViewL (Item 'Raw) -> [Value] -> IO [Value]
runInstrs decls instrs stack = case instrs of
  S.EmptyL -> return stack
  i S.:< is -> do
    stack' <- runInstr decls (itemTok i) stack
    runInstrs decls (S.viewl is) stack'

builtins :: [(Text, [Value] -> IO [Value])]
builtins =
  [ ("+", \ (IntValue x:IntValue y:rs) -> return (IntValue (x + y) : rs))
  , ("*", \ (IntValue x:IntValue y:rs) -> return (IntValue (x * y) : rs))
  , ("print", \ (val:rs) -> print val >> return rs)
  ]

runInstr :: Seq (Decl 'Raw) -> Atom -> [Value] -> IO [Value]
runInstr _decls (AtomLiteral (IntLiteral i)) st =
  return (IntValue i : st)
runInstr _decls (AtomLiteral (DoubleLiteral d)) st =
  return (DoubleValue d : st)
runInstr decls (AtomIdent name) st
  | Just cb <- lookup name builtins = cb st
  | Just decl <- F.find (\ d -> declName d == name) decls =
      runInstrs decls (S.viewl (declDefn decl)) st
  | otherwise = do
      putStrLn ("No definition named " ++ show name)
      return []