<commit_before>{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module Effect.Threading where

import Mop

import Unsafe.Coerce

import Control.Monad

-- amortized constant-time queue
data Queue = forall fs m a. Queue [Plan fs m a] [Plan fs m a]

emptyQueue = Queue [] []

newQueue stack = Queue stack []

enqueue :: (forall fs m a. Plan fs m a) -> Queue -> Queue
enqueue a (Queue l r) = Queue l (a:r)

dequeue :: Queue -> Maybe (Queue,Plan fs m a)
dequeue (Queue [] []) = Nothing
dequeue (Queue [] xs) =
  let stack = reverse xs
  in Just (Queue (tail stack) [],unsafeCoerce (head stack))
dequeue (Queue xs ys) = Just (Queue (tail xs) ys,unsafeCoerce (head xs))

data Thread k
  = forall fs m a. Thread (Plan fs m a) k
  | Yield k
  | Stop

threaded :: (Monad m,Has Thread fs m)
         => (   (forall b. Plan fs m b -> Plan fs m ())
              -> Plan fs m ()
              -> Plan fs m a
            )
         -> Plan fs m a
threaded x = do
    transform emptyQueue
      $ x (\p -> symbol (Thread (p >> symbol Stop) ()))
          (symbol (Yield ()))
  where
    transform q p0 = go p0
      where
        go p =
          case p of
            Step syms bp ->
              case prj syms of
                Just x ->
                  case x of
                    Thread child k -> transform (enqueue (unsafeCoerce child) q) (bp k)
                    Yield k ->
                      case dequeue q of
                        Nothing -> go (bp k)
                        Just (rest,nxt) -> transform (enqueue (unsafeCoerce (bp k)) rest) nxt
                    Stop ->
                      case dequeue q of
                        Nothing -> Step syms bp
                        Just (rest,nxt) -> transform rest nxt
                Nothing -> Step syms (\b -> go (bp b))
            M m -> M (fmap go m)
            Pure r ->
              case dequeue q of
                Nothing -> Pure r
                Just (rest,nxt) -> transform rest (unsafeCoerce nxt)



instance Pair Threading Thread where
  pair p (Threading k) Stop = p k undefined

data Threading k = Threading k

threading :: Uses Threading gs m => Instruction Threading gs m
threading = Threading return<commit_msg>Clean up Threading implementation and example.<commit_after>{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module Effect.Threading where

import Mop

import Unsafe.Coerce
import Control.Monad

data Thread k
  = forall fs m a. Thread (Plan fs m a) k
  | Yield k
  | Stop

-- round-robin threading
thread :: (Monad m,Has Thread fs m)
     => ((forall b. Plan fs m b -> Plan fs m ()) -> Plan fs m () -> Plan fs m a)
     -> Plan fs m a
thread x = do
    transform emptyQueue
      $ x (\p -> symbol (Thread (p >> symbol Stop) ()))
          (symbol (Yield ()))
  where
    transform q p0 = go p0
      where
        go p =
          case p of
            Step syms bp ->
              case prj syms of
                Just x ->
                  case x of
                    Thread child k ->
                      transform (enqueue (unsafeCoerce child) q) (bp k)
                    Yield k ->
                      case dequeue q of
                        Nothing -> go (bp k)
                        Just (rest,nxt) ->
                          transform (enqueue (unsafeCoerce (bp k)) rest) nxt
                    Stop ->
                      case dequeue q of
                        Nothing -> Step syms bp
                        Just (rest,nxt) -> transform rest nxt
                Nothing -> Step syms (\b -> go (bp b))
            M m -> M (fmap go m)
            Pure r ->
              case dequeue q of
                Nothing -> Pure r
                Just (rest,nxt) ->
                  transform rest (unsafeCoerce nxt)

instance Pair Threading Thread where
  pair p (Threading k) Stop = p k undefined

data Threading k = Threading k

threading :: Uses Threading gs m => Instruction Threading gs m
threading = Threading return

-- amortized constant-time queue
data Queue = forall fs m a. Queue [Plan fs m a] [Plan fs m a]

emptyQueue = Queue [] []

newQueue stack = Queue stack []

enqueue :: (forall fs m a. Plan fs m a) -> Queue -> Queue
enqueue a (Queue l r) = Queue l (a:r)

dequeue :: Queue -> Maybe (Queue,Plan fs m a)
dequeue (Queue [] []) = Nothing
dequeue (Queue [] xs) =
  let stack = reverse xs
  in Just (Queue (tail stack) [],unsafeCoerce (head stack))
dequeue (Queue xs ys) = Just (Queue (tail xs) ys,unsafeCoerce (head xs))
{'fraction_non_alphanumeric': 0.0955343257053988, 'fraction_numerical': 0.0008886914019106865, 'mean_word_length': 1.5843857634902412, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 57, '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': '3184326', 'n_tokens_mistral': 1379, 'n_tokens_neox': 1310, 'n_words': 554}