module Compiler where

import qualified Ast as A
import Control.Monad.State
import Env
import Error
import System.Environment (getEnv, getEnvironment)
import Text.Parsec (ParseError, SourcePos)
import Text.Read (Lexeme (String))

type CompState = (Env, [Error])

type CompResult = Either [Error] ()

startState :: CompState
startState = (emptyEnv, [])

-- | @foldlEither fn init xs@ folds left @xs@ applying a function @fn@ that
-- returns either, returning accumulated right and the collected lefts as a
-- list.
foldlEither :: (accr -> b -> Either accl accr) -> (accr, [accl]) -> [b] -> (accr, [accl])
foldlEither fn init xs =
  foldl
    ( \(r, l) x -> case fn r x of
        Left e -> (r, e : l)
        Right x -> (x, l)
    )
    init
    xs

compile :: [A.Expr] -> State CompState CompResult
compile (x : xs) = do
  case x of
    (A.Module name pos) -> return $ Right ()
    (A.BinOp _ a b) -> compile [a, b]
    (A.Func ident params ret body priv pos) -> do
      -- current env
      (ev, errs) <- get
      -- updated with the function
      (ev, errs) <-
        return $ case addSymUniq ev (ident, A.toFuncType params ret, pos) of
          Left err -> (ev, err : errs)
          Right ev -> (ev, errs)
      -- with parameters
      (nev, errs) <- return $ foldlEither addSymUniq (addEnv ev, errs) params
      put (nev, errs)
      r <- compile body
      (_, errs) <- get
      -- store updated errors and the env with the function
      put (ev, errs)
      return r
    (A.Call ident args pos) -> do
      id <- compile [ident]
      return $ Right ()
    (A.Return value pos) -> case value of
      Nothing -> return $ Right ()
      Just v -> compile [v]
    (A.Var ident pos) -> do
      (ev, errs) <- get
      if existsSym ev ident
        then return $ Right ()
        else do
          put (ev, Error ("undefined \"" ++ ident ++ "\"") pos : errs)
          return $ Right ()
    _ -> compile []
  compile xs
compile [] = do
  (_, errs) <- get
  case errs of
    [] -> return $ Right ()
    _ -> return $ Left errs