{-# LANGUAGE AllowAmbiguousTypes,
MagicHash,
TypeApplications,
TypeFamilies #-}
module Parsley.Internal.Backend.Machine.Types.Statics (
StaHandler#, StaHandler(..),
mkStaHandler, mkStaHandlerNoOffset, mkStaHandlerDyn, mkStaHandlerFull,
staHandler#, staHandlerEval,
StaCont#, StaCont(..),
mkStaCont, mkStaContDyn,
staCont#,
QSubroutine(..), StaSubroutine, StaFunc,
qSubroutine
) where
import Control.Monad.ST (ST)
import Data.STRef (STRef)
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Parsley.Internal.Backend.Machine.InputRep (Rep)
import Parsley.Internal.Backend.Machine.LetBindings (Regs(..))
import Parsley.Internal.Backend.Machine.Types.Dynamics (DynCont, DynHandler, DynFunc)
import Parsley.Internal.Backend.Machine.Types.Offset (Offset(offset), same)
import Parsley.Internal.Common.Utils (Code)
type StaHandler# s o a = Code (Rep o) -> Code (ST s (Maybe a))
mkStaHandler# :: forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# :: DynHandler s o a -> StaHandler# s o a
mkStaHandler# DynHandler s o a
dh Code (Rep o)
qo# = [||$$dh $$(qo#)||]
data StaHandler s o a =
StaHandler
(Maybe (Offset o))
{-# UNPACK #-} !(StaHandlerCase s o a)
(Maybe (DynHandler s o a))
staHandler# :: StaHandler s o a -> StaHandler# s o a
staHandler# :: StaHandler s o a -> StaHandler# s o a
staHandler# (StaHandler Maybe (Offset o)
_ StaHandlerCase s o a
sh Maybe (DynHandler s o a)
_) = StaHandlerCase s o a -> StaHandler# s o a
forall s o a. StaHandlerCase s o a -> StaHandler# s o a
unknown StaHandlerCase s o a
sh
_mkStaHandler :: Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a
_mkStaHandler :: Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a
_mkStaHandler Maybe (Offset o)
o StaHandler# s o a
sh = Maybe (Offset o)
-> StaHandlerCase s o a
-> Maybe (DynHandler s o a)
-> StaHandler s o a
forall s o a.
Maybe (Offset o)
-> StaHandlerCase s o a
-> Maybe (DynHandler s o a)
-> StaHandler s o a
StaHandler Maybe (Offset o)
o (StaHandler# s o a -> StaHandlerCase s o a
forall s o a. StaHandler# s o a -> StaHandlerCase s o a
mkUnknown StaHandler# s o a
sh) Maybe (DynHandler s o a)
forall a. Maybe a
Nothing
mkStaHandler :: Offset o -> StaHandler# s o a -> StaHandler s o a
mkStaHandler :: Offset o -> StaHandler# s o a -> StaHandler s o a
mkStaHandler = Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a
forall o s a.
Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a
_mkStaHandler (Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a)
-> (Offset o -> Maybe (Offset o))
-> Offset o
-> StaHandler# s o a
-> StaHandler s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset o -> Maybe (Offset o)
forall a. a -> Maybe a
Just
mkStaHandlerNoOffset :: StaHandler# s o a -> StaHandler s o a
mkStaHandlerNoOffset :: StaHandler# s o a -> StaHandler s o a
mkStaHandlerNoOffset = Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a
forall o s a.
Maybe (Offset o) -> StaHandler# s o a -> StaHandler s o a
_mkStaHandler Maybe (Offset o)
forall a. Maybe a
Nothing
mkStaHandlerDyn :: forall s o a. Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
mkStaHandlerDyn :: Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
mkStaHandlerDyn Maybe (Offset o)
c DynHandler s o a
dh = Maybe (Offset o)
-> StaHandlerCase s o a
-> Maybe (DynHandler s o a)
-> StaHandler s o a
forall s o a.
Maybe (Offset o)
-> StaHandlerCase s o a
-> Maybe (DynHandler s o a)
-> StaHandler s o a
StaHandler Maybe (Offset o)
c (StaHandler# s o a -> StaHandlerCase s o a
forall s o a. StaHandler# s o a -> StaHandlerCase s o a
mkUnknown (DynHandler s o a -> StaHandler# s o a
forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# @o DynHandler s o a
dh)) (DynHandler s o a -> Maybe (DynHandler s o a)
forall a. a -> Maybe a
Just DynHandler s o a
dh)
mkStaHandlerFull :: forall s o a. Offset o
-> DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandler s o a
mkStaHandlerFull :: Offset o
-> DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandler s o a
mkStaHandlerFull Offset o
c DynHandler s o a
handler Code (ST s (Maybe a))
yes DynHandler s o a
no = Maybe (Offset o)
-> StaHandlerCase s o a
-> Maybe (DynHandler s o a)
-> StaHandler s o a
forall s o a.
Maybe (Offset o)
-> StaHandlerCase s o a
-> Maybe (DynHandler s o a)
-> StaHandler s o a
StaHandler (Offset o -> Maybe (Offset o)
forall a. a -> Maybe a
Just Offset o
c)
(StaHandler# s o a
-> Code (ST s (Maybe a))
-> StaHandler# s o a
-> StaHandlerCase s o a
forall s o a.
StaHandler# s o a
-> Code (ST s (Maybe a))
-> StaHandler# s o a
-> StaHandlerCase s o a
mkFull (DynHandler s o a -> StaHandler# s o a
forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# @o DynHandler s o a
handler)
Code (ST s (Maybe a))
yes
(DynHandler s o a -> StaHandler# s o a
forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# @o DynHandler s o a
no))
(DynHandler s o a -> Maybe (DynHandler s o a)
forall a. a -> Maybe a
Just DynHandler s o a
handler)
staHandlerEval :: StaHandler s o a -> Offset o -> Code (ST s (Maybe a))
staHandlerEval :: StaHandler s o a -> Offset o -> Code (ST s (Maybe a))
staHandlerEval (StaHandler (Just Offset o
c) StaHandlerCase s o a
sh Maybe (DynHandler s o a)
_) Offset o
o
| Just Bool
True <- Offset o -> Offset o -> Maybe Bool
forall o. Offset o -> Offset o -> Maybe Bool
same Offset o
c Offset o
o = (Code (Rep o) -> Code (ST s (Maybe a)))
-> (Code (ST s (Maybe a)) -> Code (Rep o) -> Code (ST s (Maybe a)))
-> Maybe (Code (ST s (Maybe a)))
-> Code (Rep o)
-> Code (ST s (Maybe a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StaHandlerCase s o a -> Code (Rep o) -> Code (ST s (Maybe a))
forall s o a. StaHandlerCase s o a -> StaHandler# s o a
unknown StaHandlerCase s o a
sh) Code (ST s (Maybe a)) -> Code (Rep o) -> Code (ST s (Maybe a))
forall a b. a -> b -> a
const (StaHandlerCase s o a -> Maybe (Code (ST s (Maybe a)))
forall s o a. StaHandlerCase s o a -> Maybe (Code (ST s (Maybe a)))
yesSame StaHandlerCase s o a
sh) (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
o)
| Just Bool
False <- Offset o -> Offset o -> Maybe Bool
forall o. Offset o -> Offset o -> Maybe Bool
same Offset o
c Offset o
o = (Code (Rep o) -> Code (ST s (Maybe a)))
-> Maybe (Code (Rep o) -> Code (ST s (Maybe a)))
-> Code (Rep o)
-> Code (ST s (Maybe a))
forall a. a -> Maybe a -> a
fromMaybe (StaHandlerCase s o a -> Code (Rep o) -> Code (ST s (Maybe a))
forall s o a. StaHandlerCase s o a -> StaHandler# s o a
unknown StaHandlerCase s o a
sh) (StaHandlerCase s o a
-> Maybe (Code (Rep o) -> Code (ST s (Maybe a)))
forall s o a. StaHandlerCase s o a -> Maybe (StaHandler# s o a)
notSame StaHandlerCase s o a
sh) (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
o)
staHandlerEval (StaHandler Maybe (Offset o)
_ StaHandlerCase s o a
sh Maybe (DynHandler s o a)
_) Offset o
o = StaHandlerCase s o a -> Code (Rep o) -> Code (ST s (Maybe a))
forall s o a. StaHandlerCase s o a -> StaHandler# s o a
unknown StaHandlerCase s o a
sh (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
o)
data StaHandlerCase s o a = StaHandlerCase {
StaHandlerCase s o a -> StaHandler# s o a
unknown :: StaHandler# s o a,
StaHandlerCase s o a -> Maybe (Code (ST s (Maybe a)))
yesSame :: Maybe (Code (ST s (Maybe a))),
StaHandlerCase s o a -> Maybe (StaHandler# s o a)
notSame :: Maybe (StaHandler# s o a)
}
mkUnknown :: StaHandler# s o a -> StaHandlerCase s o a
mkUnknown :: StaHandler# s o a -> StaHandlerCase s o a
mkUnknown StaHandler# s o a
h = StaHandler# s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (StaHandler# s o a)
-> StaHandlerCase s o a
forall s o a.
StaHandler# s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (StaHandler# s o a)
-> StaHandlerCase s o a
StaHandlerCase StaHandler# s o a
h Maybe (Code (ST s (Maybe a)))
forall a. Maybe a
Nothing Maybe (StaHandler# s o a)
forall a. Maybe a
Nothing
mkFull :: StaHandler# s o a -> Code (ST s (Maybe a)) -> StaHandler# s o a -> StaHandlerCase s o a
mkFull :: StaHandler# s o a
-> Code (ST s (Maybe a))
-> StaHandler# s o a
-> StaHandlerCase s o a
mkFull StaHandler# s o a
h Code (ST s (Maybe a))
yes StaHandler# s o a
no = StaHandler# s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (StaHandler# s o a)
-> StaHandlerCase s o a
forall s o a.
StaHandler# s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (StaHandler# s o a)
-> StaHandlerCase s o a
StaHandlerCase StaHandler# s o a
h (Code (ST s (Maybe a)) -> Maybe (Code (ST s (Maybe a)))
forall a. a -> Maybe a
Just Code (ST s (Maybe a))
yes) (StaHandler# s o a -> Maybe (StaHandler# s o a)
forall a. a -> Maybe a
Just StaHandler# s o a
no)
type StaCont# s o a x = Code x -> Code (Rep o) -> Code (ST s (Maybe a))
data StaCont s o a x = StaCont (StaCont# s o a x) (Maybe (DynCont s o a x))
mkStaContDyn :: DynCont s o a x -> StaCont s o a x
mkStaContDyn :: DynCont s o a x -> StaCont s o a x
mkStaContDyn DynCont s o a x
dk = StaCont# s o a x -> Maybe (DynCont s o a x) -> StaCont s o a x
forall s o a x.
StaCont# s o a x -> Maybe (DynCont s o a x) -> StaCont s o a x
StaCont (\Code x
x Code (Rep o)
o# -> [|| $$dk $$x $$(o#) ||]) (DynCont s o a x -> Maybe (DynCont s o a x)
forall a. a -> Maybe a
Just DynCont s o a x
dk)
staCont# :: StaCont s o a x -> StaCont# s o a x
staCont# :: StaCont s o a x -> StaCont# s o a x
staCont# (StaCont StaCont# s o a x
sk Maybe (DynCont s o a x)
_) = StaCont# s o a x
sk
mkStaCont :: StaCont# s o a x -> StaCont s o a x
mkStaCont :: StaCont# s o a x -> StaCont s o a x
mkStaCont StaCont# s o a x
sk = StaCont# s o a x -> Maybe (DynCont s o a x) -> StaCont s o a x
forall s o a x.
StaCont# s o a x -> Maybe (DynCont s o a x) -> StaCont s o a x
StaCont StaCont# s o a x
sk Maybe (DynCont s o a x)
forall a. Maybe a
Nothing
type StaSubroutine s o a x = DynCont s o a x -> Code (Rep o) -> DynHandler s o a -> Code (ST s (Maybe a))
type family StaFunc (rs :: [Type]) s o a x where
StaFunc '[] s o a x = StaSubroutine s o a x
StaFunc (r : rs) s o a x = Code (STRef s r) -> StaFunc rs s o a x
data QSubroutine s o a x = forall rs. QSubroutine (StaFunc rs s o a x) (Regs rs)
qSubroutine :: forall s o a x rs. DynFunc rs s o a x -> Regs rs -> QSubroutine s o a x
qSubroutine :: DynFunc rs s o a x -> Regs rs -> QSubroutine s o a x
qSubroutine DynFunc rs s o a x
func Regs rs
frees = StaFunc rs s o a x -> Regs rs -> QSubroutine s o a x
forall s o a x (rs :: [Type]).
StaFunc rs s o a x -> Regs rs -> QSubroutine s o a x
QSubroutine (Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
forall (rs :: [Type]).
Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
staFunc Regs rs
frees DynFunc rs s o a x
func) Regs rs
frees
where
staFunc :: forall rs. Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
staFunc :: Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
staFunc Regs rs
NoRegs DynFunc rs s o a x
func = \Q (TExp (x -> Rep o -> ST s (Maybe a)))
dk Q (TExp (Rep o))
o# Q (TExp (Rep o -> ST s (Maybe a)))
dh -> [|| $$func $$dk $$(o#) $$dh ||]
staFunc (FreeReg ΣVar r
_ Regs rs
witness) DynFunc rs s o a x
func = \Q (TExp (STRef s r))
r -> Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
forall (rs :: [Type]).
Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
staFunc Regs rs
witness [|| $$func $$r ||]