{-# LANGUAGE AllowAmbiguousTypes,
ImplicitParams,
MagicHash,
RecordWildCards,
TypeApplications,
TypeFamilies,
UnboxedTuples #-}
module Parsley.Internal.Backend.Machine.Types.Statics (
StaHandler#, StaHandler, AugmentedStaHandler, StaHandlerCase,
fromStaHandler#, fromDynHandler, staHandler#,
augmentHandler, augmentHandlerSta, augmentHandlerDyn, augmentHandlerFull,
staHandlerEval, staHandlerCharacteristicSta, staHandlerCharacteristicDyn,
StaCont#, StaCont(..),
mkStaCont, mkStaContDyn,
staCont#,
QSubroutine(..), StaSubroutine, StaSubroutine#, StaFunc,
qSubroutine, mkStaSubroutine, mkStaSubroutineMeta,
staSubroutine#, meta,
) where
import Control.Monad.ST (ST)
import Data.STRef (STRef)
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Parsley.Internal.Backend.Machine.LetBindings (Regs(..), Metadata, newMeta)
import Parsley.Internal.Backend.Machine.InputOps (DynOps)
import Parsley.Internal.Backend.Machine.Types.Dynamics (DynCont, DynHandler, DynFunc)
import Parsley.Internal.Backend.Machine.Types.Input (Input(..), Input#(..), fromInput)
import Parsley.Internal.Backend.Machine.Types.Input.Offset (Offset, same)
import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic(..))
import Parsley.Internal.Common.Utils (Code)
import qualified Parsley.Internal.Opt as Opt
type StaHandler# s o a = Input# o -> Code (ST s (Maybe a))
mkStaHandler# :: forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# :: forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# DynHandler s o a
dh Input# o
inp = [||$$dh $$(pos# inp) $$(off# inp)||]
data StaHandler s o a = StaHandler {
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# :: !(StaHandler# s o a),
forall s o a. StaHandler s o a -> Maybe (DynHandler s o a)
dynOrigin :: !(Maybe (DynHandler s o a))
}
dynHandler :: (StaHandler# s o a -> DynHandler s o a) -> StaHandler s o a -> DynHandler s o a
dynHandler :: forall s o a.
(StaHandler# s o a -> DynHandler s o a)
-> StaHandler s o a -> DynHandler s o a
dynHandler StaHandler# s o a -> DynHandler s o a
conv = forall a. a -> Maybe a -> a
fromMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaHandler# s o a -> DynHandler s o a
conv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall s o a. StaHandler s o a -> Maybe (DynHandler s o a)
dynOrigin
fromStaHandler# :: StaHandler# s o a -> StaHandler s o a
fromStaHandler# :: forall s o a. StaHandler# s o a -> StaHandler s o a
fromStaHandler# StaHandler# s o a
h = forall s o a.
StaHandler# s o a -> Maybe (DynHandler s o a) -> StaHandler s o a
StaHandler StaHandler# s o a
h forall a. Maybe a
Nothing
fromDynHandler :: forall s o a. DynHandler s o a -> StaHandler s o a
fromDynHandler :: forall s o a. DynHandler s o a -> StaHandler s o a
fromDynHandler DynHandler s o a
h = forall s o a.
StaHandler# s o a -> Maybe (DynHandler s o a) -> StaHandler s o a
StaHandler (forall o s a. DynHandler s o a -> StaHandler# s o a
mkStaHandler# @o DynHandler s o a
h) (forall a. a -> Maybe a
Just DynHandler s o a
h)
data AugmentedStaHandler s o a =
AugmentedStaHandler
(Maybe (Offset o))
(StaHandlerCase s o a)
augmentHandlerSta :: Maybe (Input o) -> StaHandler# s o a -> AugmentedStaHandler s o a
augmentHandlerSta :: forall o s a.
Maybe (Input o) -> StaHandler# s o a -> AugmentedStaHandler s o a
augmentHandlerSta Maybe (Input o)
o = forall o s a.
Maybe (Input o) -> StaHandler s o a -> AugmentedStaHandler s o a
augmentHandler Maybe (Input o)
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s o a. StaHandler# s o a -> StaHandler s o a
fromStaHandler#
augmentHandlerDyn :: forall s o a. Maybe (Input o) -> DynHandler s o a -> AugmentedStaHandler s o a
augmentHandlerDyn :: forall s o a.
Maybe (Input o) -> DynHandler s o a -> AugmentedStaHandler s o a
augmentHandlerDyn Maybe (Input o)
c = forall o s a.
Maybe (Input o) -> StaHandler s o a -> AugmentedStaHandler s o a
augmentHandler Maybe (Input o)
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s o a. DynHandler s o a -> StaHandler s o a
fromDynHandler
augmentHandler :: Maybe (Input o) -> StaHandler s o a -> AugmentedStaHandler s o a
augmentHandler :: forall o s a.
Maybe (Input o) -> StaHandler s o a -> AugmentedStaHandler s o a
augmentHandler Maybe (Input o)
c = forall s o a.
Maybe (Offset o)
-> StaHandlerCase s o a -> AugmentedStaHandler s o a
AugmentedStaHandler (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall o. Input o -> Offset o
off Maybe (Input o)
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s o a. StaHandler s o a -> StaHandlerCase s o a
mkUnknown
augmentHandlerFull :: Input o
-> StaHandler s o a
-> Code (ST s (Maybe a))
-> StaHandler s o a
-> AugmentedStaHandler s o a
augmentHandlerFull :: forall o s a.
Input o
-> StaHandler s o a
-> Code (ST s (Maybe a))
-> StaHandler s o a
-> AugmentedStaHandler s o a
augmentHandlerFull Input o
c StaHandler s o a
handler Code (ST s (Maybe a))
yes StaHandler s o a
no = forall s o a.
Maybe (Offset o)
-> StaHandlerCase s o a -> AugmentedStaHandler s o a
AugmentedStaHandler (forall a. a -> Maybe a
Just (forall o. Input o -> Offset o
off Input o
c))
(forall s o a.
StaHandler s o a
-> Code (ST s (Maybe a))
-> StaHandler s o a
-> StaHandlerCase s o a
mkFull StaHandler s o a
handler
Code (ST s (Maybe a))
yes
StaHandler s o a
no)
staHandlerEval :: (DynOps o, ?flags :: Opt.Flags) => AugmentedStaHandler s o a -> Input o -> Code (ST s (Maybe a))
staHandlerEval :: forall o s a.
(DynOps o, ?flags::Flags) =>
AugmentedStaHandler s o a -> Input o -> Code (ST s (Maybe a))
staHandlerEval (AugmentedStaHandler (Just Offset o
c) StaHandlerCase s o a
sh) Input o
inp
| Flags -> Bool
Opt.deduceFailPath ?flags::Flags
?flags
, Just Bool
True <- forall o. Offset o -> Offset o -> Maybe Bool
same Offset o
c (forall o. Input o -> Offset o
off Input o
inp) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown StaHandlerCase s o a
sh)) forall a b. a -> b -> a
const (forall s o a. StaHandlerCase s o a -> Maybe (Code (ST s (Maybe a)))
yesSame StaHandlerCase s o a
sh) (forall o. DynOps o => Input o -> Input# o
fromInput Input o
inp)
| Flags -> Bool
Opt.deduceFailPath ?flags::Flags
?flags
, Just Bool
False <- forall o. Offset o -> Offset o -> Maybe Bool
same Offset o
c (forall o. Input o -> Offset o
off Input o
inp) = forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (forall a. a -> Maybe a -> a
fromMaybe (forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown StaHandlerCase s o a
sh) (forall s o a. StaHandlerCase s o a -> Maybe (StaHandler s o a)
notSame StaHandlerCase s o a
sh)) (forall o. DynOps o => Input o -> Input# o
fromInput Input o
inp)
staHandlerEval (AugmentedStaHandler Maybe (Offset o)
_ StaHandlerCase s o a
sh) Input o
inp = forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown StaHandlerCase s o a
sh) (forall o. DynOps o => Input o -> Input# o
fromInput Input o
inp)
staHandlerCharacteristic :: AugmentedStaHandler s o a -> (StaHandler# s o a -> DynHandler s o a) -> InputCharacteristic -> StaHandler s o a
staHandlerCharacteristic :: forall s o a.
AugmentedStaHandler s o a
-> (StaHandler# s o a -> DynHandler s o a)
-> InputCharacteristic
-> StaHandler s o a
staHandlerCharacteristic (AugmentedStaHandler Maybe (Offset o)
_ StaHandlerCase s o a
sh) StaHandler# s o a -> DynHandler s o a
conv InputCharacteristic
NeverConsumes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown StaHandlerCase s o a
sh) (forall s o a.
StaHandler# s o a -> Maybe (DynHandler s o a) -> StaHandler s o a
StaHandler forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. a -> b -> a
const forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaHandler# s o a -> DynHandler s o a
conv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const) (forall s o a. StaHandlerCase s o a -> Maybe (Code (ST s (Maybe a)))
yesSame StaHandlerCase s o a
sh)
staHandlerCharacteristic (AugmentedStaHandler Maybe (Offset o)
_ StaHandlerCase s o a
sh) StaHandler# s o a -> DynHandler s o a
_ (AlwaysConsumes Maybe Word
_) = forall a. a -> Maybe a -> a
fromMaybe (forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown StaHandlerCase s o a
sh) (forall s o a. StaHandlerCase s o a -> Maybe (StaHandler s o a)
notSame StaHandlerCase s o a
sh)
staHandlerCharacteristic (AugmentedStaHandler Maybe (Offset o)
_ StaHandlerCase s o a
sh) StaHandler# s o a -> DynHandler s o a
_ InputCharacteristic
MayConsume = forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown StaHandlerCase s o a
sh
staHandlerCharacteristicSta :: AugmentedStaHandler s o a -> InputCharacteristic -> StaHandler# s o a
staHandlerCharacteristicSta :: forall s o a.
AugmentedStaHandler s o a
-> InputCharacteristic -> StaHandler# s o a
staHandlerCharacteristicSta AugmentedStaHandler s o a
sh = forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s o a.
AugmentedStaHandler s o a
-> (StaHandler# s o a -> DynHandler s o a)
-> InputCharacteristic
-> StaHandler s o a
staHandlerCharacteristic AugmentedStaHandler s o a
sh forall a. HasCallStack => a
undefined
staHandlerCharacteristicDyn :: AugmentedStaHandler s o a -> (StaHandler# s o a -> DynHandler s o a) -> InputCharacteristic -> DynHandler s o a
staHandlerCharacteristicDyn :: forall s o a.
AugmentedStaHandler s o a
-> (StaHandler# s o a -> DynHandler s o a)
-> InputCharacteristic
-> DynHandler s o a
staHandlerCharacteristicDyn AugmentedStaHandler s o a
sh StaHandler# s o a -> DynHandler s o a
conv = forall s o a.
(StaHandler# s o a -> DynHandler s o a)
-> StaHandler s o a -> DynHandler s o a
dynHandler StaHandler# s o a -> DynHandler s o a
conv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s o a.
AugmentedStaHandler s o a
-> (StaHandler# s o a -> DynHandler s o a)
-> InputCharacteristic
-> StaHandler s o a
staHandlerCharacteristic AugmentedStaHandler s o a
sh StaHandler# s o a -> DynHandler s o a
conv
data StaHandlerCase s (o :: Type) a = StaHandlerCase {
forall s o a. StaHandlerCase s o a -> StaHandler s o a
unknown :: {-# UNPACK #-} !(StaHandler s o a),
forall s o a. StaHandlerCase s o a -> Maybe (Code (ST s (Maybe a)))
yesSame :: !(Maybe (Code (ST s (Maybe a)))),
forall s o 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 :: forall s o a. StaHandler s o a -> StaHandlerCase s o a
mkUnknown StaHandler s o a
h = 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing
mkFull :: StaHandler s o a -> Code (ST s (Maybe a)) -> StaHandler s o a -> StaHandlerCase s o a
mkFull :: forall s o a.
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 = 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 (forall a. a -> Maybe a
Just Code (ST s (Maybe a))
yes) (forall a. a -> Maybe a
Just StaHandler s o a
no)
type StaCont# s o a x = Code x -> Input# 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 :: forall o s a x. DynCont s o a x -> StaCont s o a x
mkStaContDyn :: forall o s a x. DynCont s o a x -> StaCont s o a x
mkStaContDyn DynCont s o a x
dk = 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 Input# o
inp -> [|| $$dk $$x $$(pos# inp) $$(off# inp) ||]) (forall a. a -> Maybe a
Just DynCont s o a x
dk)
staCont# :: StaCont s o a x -> StaCont# s o a x
staCont# :: forall s o a x. 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 :: forall s o a x. StaCont# s o a x -> StaCont s o a x
mkStaCont StaCont# s o a x
sk = 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 forall a. Maybe a
Nothing
type StaSubroutine# s o a x = DynCont s o a x -> DynHandler s o a -> Input# o -> Code (ST s (Maybe a))
data StaSubroutine s o a x = StaSubroutine {
forall s o a x. StaSubroutine s o a x -> StaSubroutine# s o a x
staSubroutine# :: !(StaSubroutine# s o a x),
forall s o a x. StaSubroutine s o a x -> Metadata
meta :: {-# UNPACK #-} !Metadata
}
mkStaSubroutine :: StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutine :: forall s o a x. StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutine = forall s o a x.
Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutineMeta Metadata
newMeta
mkStaSubroutineMeta :: Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutineMeta :: forall s o a x.
Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutineMeta = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s o a x.
StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x
StaSubroutine
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 -> Metadata -> QSubroutine s o a x
qSubroutine :: forall s o a x (rs :: [Type]).
DynFunc rs s o a x -> Regs rs -> Metadata -> QSubroutine s o a x
qSubroutine DynFunc rs s o a x
func Regs rs
frees Metadata
meta = forall s o a x (rs :: [Type]).
StaFunc rs s o a x -> Regs rs -> QSubroutine s o a x
QSubroutine (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 :: forall (rs :: [Type]).
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 = forall s o a x.
StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x
StaSubroutine (\DynCont s o a x
dk DynHandler s o a
dh Input# o
inp -> [|| $$func $$dk $$dh $$(pos# inp) $$(off# inp) ||]) Metadata
meta
staFunc (FreeReg ΣVar r
_ Regs rs1
witness) DynFunc rs s o a x
func = \Code Q (STRef s r)
r -> forall (rs :: [Type]).
Regs rs -> DynFunc rs s o a x -> StaFunc rs s o a x
staFunc Regs rs1
witness [|| $$func $$r ||]