<commit_before>{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Ivory.Language.Coroutine (
  Coroutine(..), coroutine
) where

import Control.Applicative
import Control.Monad.Fix
import qualified Data.DList as D
import qualified Data.Map as Map
import Data.Monoid
import Ivory.Language.Area
import Ivory.Language.Array
import Ivory.Language.Effects
import Ivory.Language.IBool
import Ivory.Language.Module
import Ivory.Language.Monad
import Ivory.Language.Proc
import Ivory.Language.Proxy
import Ivory.Language.Ref
import qualified Ivory.Language.Syntax as AST
import Ivory.Language.Type
import qualified MonadLib

-- Optimizations TODO:
-- TODO: remove blocks that are not reached
-- TODO: inline empty blocks (preferably, allow comments)
-- TODO: run variable rewrite side effects only once per expression
-- TODO: re-use continuation variables that have gone out of scope
-- TODO: full liveness analysis to maximize re-use
-- TODO: only extract a variable to the continuation if it is live across a suspend

data Coroutine a = Coroutine
  { coroutineName :: String
  , coroutineRun :: forall eff s s'. GetAlloc eff ~ Scope s' => IBool -> ConstRef s a -> Ivory eff ()
  , coroutineDef :: ModuleDef
  }

-- TODO: allow fromYield to have parameters and assumptions; forward those into coroutineInit.
coroutine :: forall a. IvoryArea a => ((forall s eff. Ivory eff (Ref s a)) -> Def ('[] :-> ())) -> Coroutine a
coroutine fromYield = Coroutine { .. }
  where
  DefProc (AST.Proc { AST.procSym = name, AST.procBody = rawCode }) = fromYield $ call (proc yieldName $ body $ return ())

  params = CoroutineParams
    { getCont = AST.ExpLabel strTy $ AST.ExpAddrOfGlobal $ AST.areaSym cont
    , getBreakLabel = error "Ivory.Language.Coroutine: no break label set, but breakOut called"
    }

  initialState = CoroutineState
    { rewrites = Map.empty
    , labels = []
    , derefs = 0
    }

  -- Even the initial block needs a label, in case there's a yield or
  -- return before any control flow statements. Otherwise, the resulting
  -- resumeAt call will emit a 'break;' statement outside of the
  -- forever-loop that the state machine runs in, which is invalid C.
  initCode = do
    label <- makeLabel $ extractLocals (resumeAt 0) rawCode
    goto label
  (((initBB, _), (localVars, resumes)), finalState) = MonadLib.runM (getBlock [] initCode) params initialState<commit_msg>Coroutines: don't wrap the body in a proc.<commit_after>{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Ivory.Language.Coroutine (
  Coroutine(..), CoroutineBody(..), coroutine
) where

import Control.Applicative
import Control.Monad.Fix
import qualified Data.DList as D
import qualified Data.Map as Map
import Data.Monoid
import Ivory.Language.Area
import Ivory.Language.Array
import Ivory.Language.Effects
import Ivory.Language.IBool
import Ivory.Language.Module
import Ivory.Language.Monad
import Ivory.Language.Proc
import Ivory.Language.Proxy
import Ivory.Language.Ref
import qualified Ivory.Language.Syntax as AST
import Ivory.Language.Type
import qualified MonadLib

-- Optimizations TODO:
-- TODO: remove blocks that are not reached
-- TODO: inline empty blocks (preferably, allow comments)
-- TODO: run variable rewrite side effects only once per expression
-- TODO: re-use continuation variables that have gone out of scope
-- TODO: full liveness analysis to maximize re-use
-- TODO: only extract a variable to the continuation if it is live across a suspend

data Coroutine a = Coroutine
  { coroutineName :: String
  , coroutineRun :: forall eff s s'. GetAlloc eff ~ Scope s' => IBool -> ConstRef s a -> Ivory eff ()
  , coroutineDef :: ModuleDef
  }

newtype CoroutineBody a = CoroutineBody (forall s1 s2. (forall eff. ClearBreak eff ~ ProcEffects s2 () => Ivory eff (Ref s1 a)) -> Ivory (ProcEffects s2 ()) ())

coroutine :: forall a. IvoryArea a => String -> CoroutineBody a -> Coroutine a
coroutine name (CoroutineBody fromYield) = Coroutine { .. }
  where
  ((), CodeBlock { blockStmts = rawCode }) = runIvory $ fromYield $ call (proc yieldName $ body $ return ())

  params = CoroutineParams
    { getCont = AST.ExpLabel strTy $ AST.ExpAddrOfGlobal $ AST.areaSym cont
    , getBreakLabel = error "Ivory.Language.Coroutine: no break label set, but breakOut called"
    }

  initialState = CoroutineState
    { rewrites = Map.empty
    , labels = []
    , derefs = 0
    }

  -- Even the initial block needs a label, in case there's a yield or
  -- return before any control flow statements. Otherwise, the resulting
  -- resumeAt call will emit a 'break;' statement outside of the
  -- forever-loop that the state machine runs in, which is invalid C.
  initCode = do
    label <- makeLabel $ extractLocals (resumeAt 0) rawCode
    goto label
  (((initBB, _), (localVars, resumes)), finalState) = MonadLib.runM (getBlock [] initCode) params initialState
{'fraction_non_alphanumeric': 0.09863813229571984, 'fraction_numerical': 0.0017509727626459145, 'mean_word_length': 3.8454288407163055, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 18, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4995655', 'n_tokens_mistral': 1562, 'n_tokens_neox': 1563, 'n_words': 558}