Interpreter.hs

module Interpreter.Interpreter where

import Prelude hiding (map)

import Control.Monad.IO.Unlift
import Control.Monad.Catch (try)
import Control.Concurrent
import Control.Concurrent.STM as STM
import Control.Exception (throw, IOException)
import Control.Monad
import Control.Monad.Catch (catch)
import Control.Monad.Loops (iterateWhile)
import Data.Coerce
import qualified Data.List.NonEmpty as NE
import Data.Map as M hiding (map)
import Data.Text as T hiding (index, map)
import qualified Data.Text as T (index)
import qualified Data.Vector as V
import qualified Data.ByteString as BS
import System.Posix.Directory as POSIX
import System.FilePath
import System.Directory

import Common
import Compiler.AST.FunctionStatement
import Compiler.AST.Program
import Compiler.Lexer
import Interpreter.Common

lookupScope :: ScopeKey -> InterpretM Value
lookupScope key =
  ((lookupInTopScope key . isLocal) <$> getInterpretM) >>= \case
    Just v -> pure v
    Nothing -> ((lookupInTopScope key . isModuleScope) <$> getInterpretM) >>= \case
      Just v -> pure v
      Nothing -> do
        ((M.lookup key . isGlobalScope) <$> getInterpretM) >>= \case
          Just v -> pure v
          Nothing -> throwErr $ SymbolNotFound (pack $ show key)

lookupInTopScope :: ScopeKey -> [Scope] -> Maybe Value
lookupInTopScope _ [] = Nothing
lookupInTopScope key (h: _) = M.lookup key h

evaluateExpression :: ExpressionWithLoc -> InterpretM Value
evaluateExpression exp'@(ExpressionWithLoc _ loc) =
  catch
    (catch (executeDebugStepable exp') rteHandler) peHandler
  where
    rteHandler (r :: RuntimeError) = pure $ ErrorValue $ (hReadable r) <> " at " <> hReadable loc
    peHandler (r :: ProgramError) = throwErr @(InterpretM Value) $ RuntimeErrorWithLoc (Right r) loc

evaluateExpression_ :: Expression -> InterpretM Value
evaluateExpression_ (EParan le) = evaluateExpression le
evaluateExpression_ (ENegated le) = evaluateExpression le >>= \case
  NumberValue n -> pure $ NumberValue $ negateValue n
  x             -> throwErr $ UnexpectedType ("Number", x)
evaluateExpression_ (ELiteral le) = evaluateLiteralExpression le
evaluateExpression_ (EVar idf)     = lookupScope (SkIdentifier idf) >>= \case
  BuiltIn (BuiltinVal v) -> pure v
  v                      -> pure v
evaluateExpression_ (ESubscripted subscript) = evaluateSubscriptedExpr subscript
evaluateExpression_ (EConditional boolEx ex1 ex2)  = evaluateExpression boolEx >>= \case
  BoolValue True  -> evaluateExpression ex1
  BoolValue False -> evaluateExpression ex2
  x               -> throwErr $ UnexpectedType ("Bool", x)
evaluateExpression_ (EOperator op e1 e2)  = do
  evaluateFn (FnOp op) [e1, e2] False >>= \case
    Just v  -> pure v
    Nothing -> pure Void
evaluateExpression_ (ECall (ExpressionWithLoc (EVar iden) _) exprs isTail)  =  evaluateFn (FnName iden) exprs isTail >>= \case
  Just v  -> pure v
  Nothing -> pure Void
evaluateExpression_ (ECall ex exprs isTail)  =  evaluateFn (FnExpr ex) exprs isTail >>= \case
  Just v  -> pure v
  Nothing -> pure Void
evaluateExpression_ (EUnnamedFn args expr)  = do
  isLocal <$> getInterpretM >>= \case
    [] -> pure $ UnnamedFnValue $ UnNamedFn args mempty expr
    (h: _) -> pure $ UnnamedFnValue $ UnNamedFn args h expr

popScope :: InterpretM ()
popScope = do
  (isLocal <$> getInterpretM) >>= \case
    (_:rst) -> do
      modifyInterpretM (\is -> is { isLocal = rst })
    _ -> throwErr EmptyScopeStack

data FnId
  = FnOp Operator
  | FnName Identifier
  | FnExpr ExpressionWithLoc

evaluateCallback :: Callback -> [Value] -> InterpretM (Maybe Value)
evaluateCallback (CallbackUnNamed un) args = Just <$> evaluateUnnamedFn un args
evaluateCallback (CallbackNamed idf) args =
  evaluateProcedure (SkIdentifier idf) args

insertEmptyScope :: InterpretM ()
insertEmptyScope = insertScope mempty

insertScope :: Scope -> InterpretM ()
insertScope scope = modifyInterpretM $ mapLocal (\s -> scope : s)

pushModuleScope :: Scope -> InterpretM ()
pushModuleScope scope = modifyInterpretM $ (\s -> s {isModuleScope = scope : (isModuleScope s)} )

popModuleScope :: InterpretM Scope
popModuleScope =
  (isModuleScope <$> getInterpretM) >>= \case
    [] -> throwErr EmptyModuleScopeStack
    (scp : rst) -> do
      modifyInterpretM $ (\s -> s {isModuleScope = rst} )
      pure scp

evaluateUnnamedFn :: UnNamedFn -> [Value] -> InterpretM Value
evaluateUnnamedFn (UnNamedFn [] scope expr) _ = do
  insertScope scope
  x <- evaluateExpression expr
  popScope
  pure x
evaluateUnnamedFn (UnNamedFn argNames scope expr) argsVals = do
  insertScope scope
  zipWithM_ (\a1 a2 -> insertBinding False a1 a2) (SkIdentifier <$> argNames) argsVals -- @TODO Check argument counts
  r <- evaluateExpression expr
  popScope
  pure r

evaluateProcedure_ :: Value -> [Value] -> InterpretM (Maybe Value)
evaluateProcedure_ fnVal args = case fnVal of
  ModuleValue fp (ScopeRef scopeRef) (Just fnId) -> do
    scope <- liftIO $ readTVarIO scopeRef
    pushModuleScope scope
    lookupScope (SkIdentifier fnId) >>= \case
      ProcedureValue fndef -> do
        insertEmptyScope
        oldFp <- isCurrentModulePath <$> getInterpretM
        modifyInterpretM (\is -> is { isCurrentModulePath = Just fp })
        r <- case fndef of
          FunctionDef False _ _ _ -> runProcedure fndef
          FunctionDef True _ _ _ -> withStateClone $ runProcedure fndef
        finalModuleScope <- popModuleScope
        modifyInterpretM (\is -> is { isCurrentModulePath = oldFp })
        liftIO $ atomically $ writeTVar scopeRef finalModuleScope
        pure r
      _ -> throwErr $ SymbolNotFound (pack $ show fnId)
  UnnamedFnValue un -> Just <$> evaluateUnnamedFn un args
  ProcedureValue fndef -> do
    insertEmptyScope
    runProcedure fndef
  (BuiltIn (BuiltinCall cb)) -> cb args
  (BuiltIn (BuiltinCallWithDoc (SomeBuiltin cb))) -> cb (toArgs args)
  a -> throwErr $ UnexpectedType ("Procedure", a)
  where
    runProcedure :: FunctionDef -> InterpretM (Maybe Value)
    runProcedure = \case
      FunctionDef True a b c -> do
        inChan <- liftIO newTChanIO
        outChan <- liftIO newTChanIO
        let gChans = GeneratorChannels inChan outChan
        void $ withRunInIO $ \runInIO -> forkIO $ runInIO (do
            modifyInterpretM (\is -> is { isGeneratorChannels = Just gChans })
            void $ runProcedure $ FunctionDef False a b c
            liftIO $ atomically $ writeTChan outChan Nothing
            )
        pure $ Just $ GeneratorValue gChans

      FunctionDef False _ argNames (NE.toList -> stms) -> do
        zipWithM_ (\a1 a2 -> insertBinding False a1 a2) (SkIdentifier <$> argNames) args -- @TODO Check argument counts
        executeStatements stms >>= \case
          ProcReturn False v -> do
            popScope
            pure $ Just v
          ProcReturn True v -> do
            -- Don't pop stack if the return was a tail call return
            -- because the stack was popped before entering the
            -- call.
            pure $ Just v
          ProcBreak -> do
            popScope
            pure Nothing
          ProcContinue -> do
            popScope
            pure Nothing

evaluateProcedure :: ScopeKey -> [Value] -> InterpretM (Maybe Value)
evaluateProcedure sk args =
  lookupScope sk >>= (\x -> evaluateProcedure_ x args)

evaluateFn :: FnId -> [ExpressionWithLoc] -> Bool -> InterpretM (Maybe Value)
evaluateFn fnId argsExps isTail = do
  args <- mapM (\x -> evaluateExpression x) argsExps
  fnVal <- case fnId of
    FnOp op -> lookupScope (SkOperator op)
    FnName op -> lookupScope (SkIdentifier op)
    FnExpr expr -> evaluateExpression expr
  if isTail
    then do
      popScope
      evaluateProcedure_ fnVal args
    else evaluateProcedure_ fnVal args

evaluateSubscriptedExpr :: SubscriptedExpression -> InterpretM Value
evaluateSubscriptedExpr (EArraySubscript expr indexExpr) = evaluateExpression expr >>= \case
  StringValue v -> evaluateExpression indexExpr >>= \case
    NumberValue (NumberInt i) -> do
      let index :: Int = fromIntegral i
      if index <= T.length v && index >= 0
        then pure $ StringValue $ T.singleton (T.index v (index - 1))
        else (throwErr $ IndexOutOfBounds index)
    a -> throwErr $ UnexpectedType ("Integer index", a)
  BytesValue v -> evaluateExpression indexExpr >>= \case
    NumberValue (NumberInt i) -> do
      let index :: Int = fromIntegral i
      case BS.indexMaybe v (index - 1) of
        Just w -> pure $ NumberValue $ NumberInt $ fromIntegral w
        Nothing -> (throwErr $ IndexOutOfBounds index)
    a -> throwErr $ UnexpectedType ("Integer index", a)
  ArrayValue v -> evaluateExpression indexExpr >>= \case
    NumberValue (NumberInt i) -> do
      let index :: Int = fromIntegral i
      if index <= V.length v && index >= 0 then (pure $ v V.! (index - 1)) else (throwErr $ IndexOutOfBounds index)
    a -> throwErr $ UnexpectedType ("Integer index", a)
  ObjectValue mp -> evaluateExpression indexExpr >>= \case
    StringValue key -> case M.lookup key mp of
      Just v  -> pure v
      Nothing -> throwErr $ KeyNotFound (pack $ show key)
    a -> throwErr $ UnexpectedType ("Property index", a)
  a -> throwErr $ UnexpectedType ("Array/Map", a)
evaluateSubscriptedExpr (EPropertySubscript expr (unIdentifer -> key)) = evaluateExpression expr >>= \case
  ObjectValue mp -> case M.lookup key mp of
      Just v  -> pure v
      Nothing -> throwErr $ KeyNotFound (pack $ show key)
  ModuleValue fp scope Nothing -> pure $ ModuleValue fp scope $ Just $ Identifier key
  a -> throwErr $ UnexpectedType ("Map", a)

evaluateVar :: Subscript -> InterpretM Value
evaluateVar (NoSubscript idf) = lookupScope (SkIdentifier idf) >>= \case
  BuiltIn (BuiltinVal v) -> pure $ v
  v                      -> pure v
evaluateVar (SubscriptExpr sub expr) =
  -- Arrays are indexed from 1, not 0.
  evaluateExpression expr >>= \case
      NumberValue (NumberInt int) ->
        evaluateVar sub >>= \case
          ArrayValue v -> do
            let index :: Int = fromIntegral int
            if index <= V.length v && index >= 0 then (pure $ v V.! (index - 1)) else (throwErr $ IndexOutOfBounds index)
          a -> throwErr $ UnexpectedType ("Array/Object", a)
      StringValue key -> lookupInMapVar sub key
      a  -> throwErr $ UnexpectedType ("String/Integer container key", a)
evaluateVar (PropertySubscript sub idf) = lookupInMapVar sub (unIdentifer idf)

lookupInMapVar :: Subscript -> Text -> InterpretM Value
lookupInMapVar sub key = evaluateVar sub >>= \case
  ObjectValue mp -> case M.lookup key mp of
    Just v  -> pure v
    Nothing -> throwErr $ KeyNotFound (pack $ show key)
  a            ->  throwErr $ UnexpectedType ("Expecting Object Looking for key: " <> (T.pack $ show sub) <> ":" <> key, a)

evaluateLiteralExpression :: LiteralExpression -> InterpretM Value
evaluateLiteralExpression (LAtomic (LitString t)) = pure $ StringValue t
evaluateLiteralExpression (LAtomic (LitBytes t))  = pure $ BytesValue t
evaluateLiteralExpression (LAtomic (LitNumber n)) = pure $ NumberValue $ NumberInt n
evaluateLiteralExpression (LAtomic (LitFloat f))  = pure $ NumberValue $ NumberFractional (realToFrac f)
evaluateLiteralExpression (LAtomic (LitBool b))   = pure $ BoolValue b
evaluateLiteralExpression (LArray l)   = do
  v <- mapM (\x -> evaluateExpression x) l
  pure $ ArrayValue (V.fromList v)
evaluateLiteralExpression (LObject l)   = do
  v <- mapM (\x -> evaluateExpression x) l
  pure $ ObjectValue v

voidStm :: () -> InterpretM (Maybe Value)
voidStm _ = pure Nothing

executeStatements :: [FunctionStatementWithLoc] -> InterpretM ProcResult
executeStatements x = foldM (\a1 a2 -> fn a1 a2) ProcContinue x
  where
    fn :: ProcResult -> FunctionStatementWithLoc -> InterpretM ProcResult
    fn (ProcReturn tc x') _ = pure $ ProcReturn tc x'
    fn ProcBreak _       = pure ProcBreak
    fn ProcContinue fs   = executeStatement fs

modifyBinding :: Bool -> Subscript -> Value -> InterpretM ()
modifyBinding isGlobal (NoSubscript idf) val = insertBinding isGlobal (SkIdentifier idf) val
modifyBinding isGlobal (PropertySubscript sub (unIdentifer -> key)) val = do
  evaluateVar sub >>= \case
    ObjectValue v -> case M.lookup key v of
      Just _  -> modifyBinding isGlobal sub (ObjectValue $ M.insert key val v)
      Nothing -> throwErr (KeyNotFound key)
    a -> throwErr $ UnexpectedType ("Map", a)
modifyBinding isGlobal (SubscriptExpr sub expr) val = do
  evaluateVar sub >>= \case
    ArrayValue v -> evaluateExpression expr >>= \case
      NumberValue (NumberInt idx) -> do
        let index :: Int = fromIntegral idx
        if (index <= V.length v && index > 0)
          then modifyBinding isGlobal sub (ArrayValue $ V.update v (V.fromList [(index - 1, val)]))
          else throwErr $ IndexOutOfBounds index
      a -> throwErr $ UnexpectedType ("Integer Index", a)
    BytesValue v -> evaluateExpression expr >>= \case
      NumberValue (NumberInt idx) -> do
        let index :: Int = fromIntegral idx
        if (index <= BS.length v && index > 0)
          then
            let
              prefix = BS.take (index - 1) v
              suffix = BS.drop index v
              wv = fromValue val
            in modifyBinding isGlobal sub (BytesValue $ prefix <> BS.cons wv suffix)
          else throwErr $ IndexOutOfBounds index
      a -> throwErr $ UnexpectedType ("Integer Index", a)
    StringValue v -> evaluateExpression expr >>= \case
      NumberValue (NumberInt idx) -> do
        let index :: Int = fromIntegral idx
        if (index <= T.length v && index > 0)
          then
            let
              prefix = T.take (index - 1) v
              suffix = T.drop index v
              wv = fromValue val
            in modifyBinding isGlobal sub (StringValue $ prefix <> T.cons wv suffix)
          else throwErr $ IndexOutOfBounds index
      a -> throwErr $ UnexpectedType ("Integer Index", a)
    ObjectValue v -> evaluateExpression expr >>= \case
      StringValue key -> case M.lookup key v of
        Just _  -> modifyBinding isGlobal sub (ObjectValue $ M.insert key val v)
        Nothing -> throwErr (KeyNotFound key)
      a -> throwErr $ UnexpectedType ("String", a)
    a -> throwErr $ UnexpectedType ("Map", a)

class ToSource a => DebugStepable a b | a -> b where
  getLocation :: a -> Location
  execute :: a -> InterpretM b

instance DebugStepable FunctionStatementWithLoc ProcResult where
  getLocation (FunctionStatementWithLoc _ l) = l
  execute (FunctionStatementWithLoc fs _) = executeStatement_ fs

instance DebugStepable ExpressionWithLoc Value where
  getLocation (ExpressionWithLoc _ l) = l
  execute (ExpressionWithLoc exp' _) = evaluateExpression_ exp'

executeStatement :: FunctionStatementWithLoc -> InterpretM ProcResult
executeStatement fs@(FunctionStatementWithLoc _ loc) =
  catch
    (catch (executeDebugStepable fs) rteHandler) peHandler
    where
      rteHandler (r :: RuntimeError) = case r of
        CustomRTE msg -> throw (RuntimeErrorWithLoc (Left $ CustomRTE msg) loc)
        _ -> throw (RuntimeErrorWithLoc (Left r) loc)
      peHandler (r :: ProgramError) = throw (RuntimeErrorWithLoc (Right r) loc)

executeDebugStepable :: Show a => DebugStepable a b => a -> InterpretM b
executeDebugStepable dbs = do
  isRunMode <$> getInterpretM >>= \case
    NormalMode -> do
      execute dbs
    DebugMode debugEnv@(DebugEnv { deInQueue = isDebugIn, deOutQueue = isDebugOut, deStepMode = stepMode }) -> do
      stepMode' <- case stepMode of
        Continue ->
          (liftIO $ atomically $ tryReadTBQueue isDebugIn) >>= \case
            Just StartStep -> pure SingleStep
            -- Only StartStep will trigger a break to step debugging here.
            _ -> pure Continue
        SingleStep -> pure SingleStep
      case stepMode' of
        Continue -> execute dbs
        SingleStep -> do
          -- Send location of current instruction, and wait for command.
          sendDebugOut isDebugOut
          (liftIO $ atomically $ readTBQueue isDebugIn) >>= \case
              Run -> do
                modifyInterpretM (\is -> is { isRunMode = DebugMode $ debugEnv { deStepMode = Continue } })
                execute dbs
              StepIn -> do
                modifyInterpretM (\is -> is { isRunMode = DebugMode (DebugEnv SingleStep isDebugIn isDebugOut) })
                execute dbs
              _ -> error "Unexpected debug command"
  where
    sendDebugOut debugOut = do
      is <- getInterpretM
      let currentScope = case isLocal is of
            [] -> isGlobalScope is
            (scope : _) -> scope
      let
        dd = DebugState currentScope (getLocation dbs) (Just $ trimAndElipsis $ toSource dbs) (isThreadName is)
      liftIO $ atomically $ writeTBQueue debugOut $ DebugData dd

    trimAndElipsis (T.replace "\n" " " -> t) = if T.length t > 30 then T.take 30 t <> "..." else t

executeStatement_ :: FunctionStatement -> InterpretM ProcResult
executeStatement_ (FnComment _) = pure ProcContinue
executeStatement_ (Let sub isGlobal exp') = do
  sourceValue <- evaluateExpression exp'
  modifyBinding isGlobal sub sourceValue
  pure ProcContinue
executeStatement_ (Call expr) = do
  _ <- evaluateExpression expr
  pure ProcContinue
executeStatement_ (IfThen expr stms) = evaluateExpression expr >>= \case
  BoolValue True -> executeStatements (NE.toList stms)
  BoolValue _    -> pure ProcContinue
  a              ->  throwErr $ UnexpectedType ("Bool", a)
executeStatement_ (If expr stms1 stms2) = evaluateExpression expr >>= \case
  BoolValue b -> case b of
    True  -> executeStatements (NE.toList stms1)
    False -> executeStatements (NE.toList stms2)

  a            ->  throwErr $ UnexpectedType ("Bool", a)
executeStatement_ (MultiIf expr stms1 elseifs mstms2) = evaluateExpression expr >>= \case
  BoolValue True -> executeStatements (NE.toList stms1)
  BoolValue False -> foldM executeElseIf Nothing elseifs >>= \case
    Just r  -> pure r
    Nothing -> case mstms2 of
      Just stms2 -> executeStatements (NE.toList stms2)
      Nothing    -> pure ProcContinue
  a            ->  throwErr $ UnexpectedType ("Bool", a)
  where
    executeElseIf a@(Just _) _ = pure a
    executeElseIf Nothing (bexpr, stms) = evaluateExpression bexpr >>= \case
      BoolValue True  -> Just <$> executeStatements (NE.toList stms)
      BoolValue False -> pure Nothing
      a               ->  throwErr $ UnexpectedType ("Bool", a)

executeStatement_ (Return eloc@(ExpressionWithLoc { elExpression = ECall idf args _ })) =
  -- TCO
  evaluateExpression (eloc { elExpression = ECall idf args True }) >>= pure . ProcReturn True
executeStatement_ (Return expr) = evaluateExpression expr >>= pure . ProcReturn False
executeStatement_ (Yield expr) = evaluateExpression expr >>= \v ->
  isGeneratorChannels <$> getInterpretM >>= \case
    Nothing -> error "Generator channel unavailable unexpectedly!"
    Just (GeneratorChannels inChan outChan) -> liftIO $ do
      atomically $ writeTChan outChan $ Just v
      atomically $ readTChan inChan
      pure $ ProcContinue
executeStatement_ Break = pure ProcBreak
executeStatement_ Pass = pure ProcContinue
executeStatement_ (Loop (NE.toList -> stms)) = do
  r <- iterateWhile (\case
    ProcBreak    -> False
    ProcContinue -> True
    ProcReturn _ _ -> False) (executeStatements stms)
  case r of
    ProcBreak -> pure ProcContinue
    a         -> pure a

executeStatement_ (While exprBool (NE.toList -> stms)) = do
  r <- iterateWhile (\case
    ProcBreak    -> False
    ProcContinue -> True
    ProcReturn _ _ -> False)
    (evaluateExpression exprBool >>= \case
        BoolValue True  -> executeStatements stms
        BoolValue False -> pure ProcBreak
        a               -> throwErr $ UnexpectedType ("Bool", a))
  case r of
    ProcBreak -> pure ProcContinue
    a         -> pure a
executeStatement_ (For iden exprFrom exprTo (NE.toList -> stms) mStepExpr) = do
  fromVal <- evaluateExpression exprFrom >>= \case
    NumberValue n -> pure n
    a -> throwErr $ UnexpectedType ("Int/Fractional", a)
  toVal <- evaluateExpression exprTo >>= \case
    NumberValue n -> pure n
    a -> throwErr $ UnexpectedType ("Int/Fractional", a)
  stepValue <- case mStepExpr of
    Just stepExpr -> evaluateExpression stepExpr >>= \case
      NumberValue n -> pure n
      a -> throwErr $ UnexpectedType ("Int/Fractional", a)
    Nothing -> pure $ NumberInt 1
  let
    fn :: ProcResult -> Number -> InterpretM ProcResult
    fn ProcContinue current = do
      insertBinding False (SkIdentifier iden) (NumberValue current)
      executeStatements stms
    fn r _ = pure r

  foldM (\a1 a2 -> fn a1 a2) ProcContinue (Prelude.takeWhile (<= toVal) $ iterate ((numberBinaryFn (+)) stepValue) fromVal)  >>= \case
    ProcReturn tc v -> pure $ ProcReturn tc v
    _            -> pure ProcContinue

executeStatement_ (ForEach iden expr (NE.toList -> stms)) = evaluateExpression expr >>= \case
  GeneratorValue genChans -> let
    go (ProcReturn tc v) = pure $ ProcReturn tc v
    go r =
      generatorNext genChans >>= \case
        Just v -> fn r v >>= go
        Nothing -> pure r
    in go ProcContinue
  ObjectValue map -> do
    foldM (\a1 (k, v) -> fn a1 (ObjectValue $ M.fromList [("key", StringValue k), ("value", v)])) ProcContinue (M.assocs map) >>= \case
      ProcReturn tc v -> pure $ ProcReturn tc v
      _            -> pure ProcContinue
  ArrayValue values -> do
    V.foldM (\a1 a2 -> fn a1 a2) ProcContinue values >>= \case
      ProcReturn tc v -> pure $ ProcReturn tc v
      _            -> pure ProcContinue
  DirectoryStack dhref -> do
    let go lr = do
            (liftIO $ readDirectoryStack dhref) >>= \case
              EmptyItem -> pure ProcContinue
              fi -> fn lr (mkObjectFromFileItem fi) >>= go
    go ProcContinue
  a            ->  throwErr $ UnexpectedType ("Array/Object", a)
  where
    fn :: ProcResult -> Value -> InterpretM ProcResult
    fn ProcContinue current = do
      insertBinding False (SkIdentifier iden) current
      executeStatements stms
    fn r _ = pure r

generatorNext :: GeneratorChannels -> InterpretM (Maybe Value)
generatorNext (GeneratorChannels inChan outChan) = do
  v <- liftIO $ do
    atomically $ writeTChan inChan ()
    atomically $ readTChan outChan
  case v of
    Just v' -> pure $ Just v'
    Nothing -> do
      liftIO $ atomically $ unGetTChan outChan Nothing
      pure Nothing

data FileEntry
 = FileItem FilePath
 | DirItem FilePath
 | SymlinkItem FilePath
 | ErrorItem FilePath Text
 | EmptyItem

mkObjectFromFileItem :: FileEntry -> Value
mkObjectFromFileItem EmptyItem = error "Impossible!"
mkObjectFromFileItem (FileItem t) = ObjectValue $ M.fromList [("type", StringValue "file"), ("path", StringValue $ T.pack t)]
mkObjectFromFileItem (DirItem t) = ObjectValue $ M.fromList [("type", StringValue "dir"), ("path", StringValue $ T.pack t)]
mkObjectFromFileItem (SymlinkItem t) = ObjectValue $ M.fromList [("type", StringValue "symlink"), ("path", StringValue $ T.pack t)]
mkObjectFromFileItem (ErrorItem t e) = ObjectValue $ M.fromList [("type", StringValue "error"), ("path", StringValue $ T.pack t), ("message", StringValue e)]

readDirectoryStack :: DirHandleRef -> IO FileEntry
readDirectoryStack a@(DirHandleRef recursive ref) = do
  readTVarIO ref >>= \case
    [] -> pure EmptyItem
    (DirStreamInfo (AbsoluteFilePath afp) mh: _) -> do
      eh <- case mh of
        Just h -> pure $ Right h
        Nothing -> do
          try @_ @IOException (POSIX.openDirStream afp) >>= \case
            Right h -> do
              atomically $ modifyTVar ref (\case
                [] -> error "Impossible!"
                (_:c) -> (DirStreamInfo (AbsoluteFilePath afp) (Just h) :  c))
              pure $ Right h
            Left err -> do
              atomically $ modifyTVar ref (\case
                [] -> error "Impossible!"
                (_:c) -> c)
              pure $ Left (T.pack $ show err)

      case eh of
        Left h -> pure $ ErrorItem afp h
        Right h -> do
          POSIX.readDirStream h >>= \case
            "" -> do
              -- pop top most path if it has run out of files.
              POSIX.closeDirStream h
              atomically $ modifyTVar ref (\case
                [] -> error "Impossible!"
                (_:rs) -> rs)
              readDirectoryStack a
            "." -> readDirectoryStack a
            ".." -> readDirectoryStack a
            fp -> do
              -- check if this is a dir, if yes, push it on top of stack, but
              -- only if recursion is enabled.
              -- then return its path.
              let fp' = afp </> fp
              pathIsSymbolicLink fp' >>= \case
                True -> pure (SymlinkItem fp')
                False -> if recursive
                  then do
                    doesDirectoryExist fp' >>= \case
                      True -> do
                        atomically $ modifyTVar ref (\c -> (DirStreamInfo (AbsoluteFilePath fp') Nothing :  c))
                        pure (DirItem fp')
                      _ -> pure (FileItem fp')
                  else do
                    doesDirectoryExist fp' >>= \case
                      True -> pure (DirItem fp')
                      _ -> pure (FileItem fp')

filter_ :: BuiltInFnWithDoc '[ '("list", V.Vector Value), '("callback", Callback)]
filter_ ((coerce -> v1) :> (coerce -> callback) :> _) =
  (\x -> Just $ ArrayValue x) <$> V.filterM fn v1
  where
    fn v = evaluateCallback callback [v] >>= \case
      Just (BoolValue x) -> pure x
      _           -> throwErr $ CustomRTE "Callback returned a non-bool value"


interpretPassOne :: Program -> InterpretM ()
interpretPassOne x = mapM_ (\a -> fn a) x
  where
    fn :: ProgramStatement -> InterpretM ()
    fn (FunctionDefStatement fdef@(FunctionDef _ name _ _)) = modifyInterpretM $ mapGlobalScope $
      \s -> insert (SkIdentifier name) (ProcedureValue fdef) s
    fn _ = pure ()

interpretPassTwo :: Program -> InterpretM ()
interpretPassTwo x = mapM_ (\a -> fn a) x
  where
    fn :: ProgramStatement -> InterpretM ()
    fn (FunctionDefStatement (FunctionDef _ _ _ _)) = pure ()
    fn (NakedStatement fs)                        = void $ executeStatement fs
    fn (TopLevelComment _)                        = pure ()