{-# OPTIONS_GHC -Wno-monomorphism-restriction #-}
{-# LANGUAGE AllowAmbiguousTypes,
CPP,
MagicHash,
UnboxedTuples #-}
module Parsley.Internal.Backend.Machine.BindingOps (module Parsley.Internal.Backend.Machine.BindingOps) where
import Control.Monad.ST (ST)
import Data.Array.Unboxed (UArray)
import Data.ByteString.Internal (ByteString)
import Data.Text (Text)
import Parsley.Internal.Backend.Machine.InputRep (Rep)
import Parsley.Internal.Backend.Machine.Types.Base (Handler#, Pos)
import Parsley.Internal.Backend.Machine.Types.Dynamics (DynSubroutine, DynCont, DynHandler)
import Parsley.Internal.Backend.Machine.Types.Input (Input#(..))
import Parsley.Internal.Backend.Machine.Types.Statics (StaCont#, StaHandler#, StaSubroutine#)
import Parsley.Internal.Common.Utils (Code)
import Parsley.Internal.Core.InputTypes (Text16, CharList, Stream)
import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString)
#define inputInstances(derivation) \
derivation([Char]) \
derivation((UArray Int Char)) \
derivation(Text16) \
derivation(ByteString) \
derivation(CharList) \
derivation(Stream) \
derivation(Lazy.ByteString) \
derivation(Text)
class HandlerOps o where
bindHandler# :: StaHandler# s o a
-> (DynHandler s o a -> Code b)
-> Code b
#define deriveHandlerOps(_o) \
instance HandlerOps _o where \
{ \
bindHandler# h k = [|| \
let handler (pos :: Pos) (o# :: Rep _o) = \
$$(h (Input# [||o#||] [||pos||])) \
in $$(k [||handler||]) \
||]; \
};
inputInstances(deriveHandlerOps)
class JoinBuilder o where
setupJoinPoint# :: StaCont# s o a x
-> (DynCont s o a x -> Code b)
-> Code b
#define deriveJoinBuilder(_o) \
instance JoinBuilder _o where \
{ \
setupJoinPoint# binding k = \
[|| let join x (pos :: Pos) !(o# :: Rep _o) = \
$$(binding [||x||] (Input# [||o#||] [||pos||])) in $$(k [||join||]) ||] \
};
inputInstances(deriveJoinBuilder)
class RecBuilder o where
bindIterHandler# :: (Input# o -> StaHandler# s o a)
-> (Code (Pos -> Rep o -> Handler# s o a) -> Code b)
-> Code b
bindIter# :: Input# o
-> (Code (Pos -> Rep o -> ST s (Maybe a)) -> Input# o -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
bindRec# :: (DynSubroutine s o a x -> StaSubroutine# s o a x)
-> DynSubroutine s o a x
#define deriveRecBuilder(_o) \
instance RecBuilder _o where \
{ \
bindIterHandler# h k = [|| \
let handler (posc :: Pos) (c# :: Rep _o) (poso :: Pos) (o# :: Rep _o) = \
$$(h (Input# [||c#||] [||posc||]) (Input# [||o#||] [||poso||])) in $$(k [||handler||]) \
||]; \
bindIter# inp l = [|| \
let loop (pos :: Pos) !(o# :: Rep _o) = $$(l [||loop||] (Input# [||o#||] [||pos||])) \
in loop $$(pos# inp) $$(off# inp) \
||]; \
bindRec# binding = \
{- The idea here is to try and reduce the number of times registers have to be passed around -} \
[|| let self ret h (pos :: Pos) !(o# :: Rep _o) = \
$$(binding [||self||] [||ret||] [||h||] (Input# [||o#||] [||pos||])) in self ||] \
};
inputInstances(deriveRecBuilder)
class MarshalOps o where
dynHandler# :: StaHandler# s o a -> DynHandler s o a
dynCont# :: StaCont# s o a x -> DynCont s o a x
#define deriveMarshalOps(_o) \
instance MarshalOps _o where \
{ \
dynHandler# sh = [||\ (pos :: Pos) (o# :: Rep _o) -> $$(sh (Input# [||o#||] [||pos||])) ||]; \
dynCont# sk = [||\ x (pos :: Pos) (o# :: Rep _o) -> $$(sk [||x||] (Input# [||o#||] [||pos||])) ||]; \
};
inputInstances(deriveMarshalOps)