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] (Maybe A.Type)

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 = do
  case x of
    (A.Module name pos) -> return $ Right Nothing
    (A.BinOp _ a b) -> compileAll [a, b] -- XXX
    (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, ftype, 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 <- compileAll body
      (_, errs) <- get
      -- store updated errors and the env with the function
      put (ev, errs)
      return $ Right $ Just ftype
      where
        ftype = A.toFuncType params ret
    (A.Call ident args pos) -> do
      r <- compile ident
      case r of
        p@(Right (Just (A.FuncType _ _))) -> return $ p
        Right _ -> do
          (ev, errs) <- get
          put (ev, Error ("non callable value in function call") pos : errs)
          return $ Right Nothing
        Left r -> return $ Right Nothing
    (A.Return value pos) -> case value of
      Just v -> compile v
      Nothing -> return $ Right Nothing
    (A.Var ident pos) -> do
      (ev, errs) <- get
      case getSym ev ident of
        Just (_, t, _) -> return $ Right $ Just t
        Nothing -> do
          put (ev, Error ("undefined variable \"" ++ ident ++ "\"") pos : errs)
          return $ Right Nothing
    _ -> return $ Right Nothing

compileAll :: [A.Expr] -> State CompState CompResult
compileAll (x : xs) = do
  compile x
  compileAll xs
compileAll [] = do
  (_, errs) <- get
  case errs of
    [] -> return $ Right Nothing
    _ -> return $ Left errs