{-# LANGUAGE AllowAmbiguousTypes,
             MagicHash,
             TypeApplications,
             TypeFamilies #-}
{-|
Module      : Parsley.Internal.Backend.Machine.Types.Statics
Description : Representation of components that exist within a statically known component
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module contains the types that represent statically known information that can be
refined and manipulated within a single compilation unit: i.e. not crossing recursion or
call boundaries.

@since 1.4.0.0
-}
module Parsley.Internal.Backend.Machine.Types.Statics (
    -- * Handlers
    StaHandler#, StaHandler(..), StaHandlerCase, WStaHandler#, WDynHandler,

    -- ** @StaHandler@ Builders
    -- | The following functions are builders of `StaHandler`.
    mkStaHandler, mkStaHandlerNoOffset, mkStaHandlerDyn, mkStaHandlerFull,

    -- ** @StaHandler@ Interpreters
    -- | The following functions interpret or extract information from `StaHandler`.
    staHandler#, staHandlerEval,
    staHandlerCharacteristicSta, staHandlerCharacteristicDyn,

    -- * Return Continuations
    StaCont#, StaCont(..),
    mkStaCont, mkStaContDyn,
    staCont#,

    -- * Subroutines
    QSubroutine(..), StaSubroutine, StaSubroutine#, StaFunc,
    -- ** Subroutine Builders
    qSubroutine, mkStaSubroutine, mkStaSubroutineMeta,

    -- ** Subroutine Extractors
    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.InputRep       (Rep)
import Parsley.Internal.Backend.Machine.LetBindings    (Regs(..), Metadata, newMeta, InputCharacteristic(..))
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)

-- Handlers
{-|
This represents the translation of `Parsley.Internal.Backend.Machine.Types.Base.Handler#`
but where the static function structure has been exposed. This allows for β-reduction
on handlers, a simple form of inlining optimisation.

@since 1.4.0.0
-}
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#)||]

{-|
Compared with `StaHandler#`, this type allows for the encoding of various static
properties of handlers which can be carried around during the lifetime of the handlers.
This information allows the engine to optimise more aggressively, leveraging
domain-specific optimisation data.

@since 1.5.0.0
-}
data StaHandler s o a =
  StaHandler
    (Maybe (Offset o))                         -- ^ The statically bound offset for this handler, if available.
    (StaHandlerCase WStaHandler# s o a)        -- ^ The static function representing this handler when offsets are incomparable.
    (Maybe (StaHandlerCase WDynHandler s o a)) -- ^ The dynamic handler that has been wrapped in this handler, if available.

{-|
Given a static handler, extracts the underlying handler which
has "forgotten" any static domain-specific information it had been
attached to.

@since 1.4.0.0
-}
staHandler# :: StaHandler s o a -> StaHandler# s o a
staHandler# :: StaHandler s o a -> StaHandler# s o a
staHandler# (StaHandler Maybe (Offset o)
_ StaHandlerCase WStaHandler# s o a
sh Maybe (StaHandlerCase WDynHandler s o a)
_) = WStaHandler# s o a -> StaHandler# s o a
forall s o a. WStaHandler# s o a -> StaHandler# s o a
unWrapSta (StaHandlerCase WStaHandler# s o a -> WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase WStaHandler# 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 WStaHandler# s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
-> StaHandler s o a
forall s o a.
Maybe (Offset o)
-> StaHandlerCase WStaHandler# s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
-> StaHandler s o a
StaHandler Maybe (Offset o)
o (StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
forall s o a.
StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
mkUnknownSta StaHandler# s o a
sh) Maybe (StaHandlerCase WDynHandler s o a)
forall a. Maybe a
Nothing

{-|
Augments a `StaHandler#` with information about what the offset is that
the handler has captured. This is a purely static handler, which is not
derived from a dynamic one.

@since 1.4.0.0
-}
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

{-|
Converts a `StaHandler#` into a `StaHandler` without any information
about the captured offset. This is a purely static handler, not derived
from a dynamic one.

@since 1.4.0.0
-}
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

{-|
Converts a `Parsley.Internal.Machine.Types.Dynamics.DynHandler` into a
`StaHandler` taking into account the possibility that captured offset
information is available. The dynamic handler used to construct this
static handler is maintained as the origin of the handler. This means
if it is converted back the conversion is free.

@since 1.4.0.0
-}
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 WStaHandler# s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
-> StaHandler s o a
forall s o a.
Maybe (Offset o)
-> StaHandlerCase WStaHandler# s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
-> StaHandler s o a
StaHandler Maybe (Offset o)
c (StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
forall s o a.
StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
mkUnknownSta (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)) (StaHandlerCase WDynHandler s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
forall a. a -> Maybe a
Just (DynHandler s o a -> StaHandlerCase WDynHandler s o a
forall s o a. DynHandler s o a -> StaHandlerCase WDynHandler s o a
mkUnknownDyn DynHandler s o a
dh))

{-|
When the behaviours of a handler given input that matches or does not match
its captured offset are known, this function can be used to construct a
`StaHandler` that stores this information. This can in turn be used in
conjunction with `staHandlerEval` to statically refine the application of
a handler to its argument.

@since 1.4.0.0
-}
mkStaHandlerFull :: forall s o a. Offset o -- ^ The offset captured by the creation of the handler.
                 -> DynHandler s o a       -- ^ The full handler, which can be used when offsets are incomparable and must perform the check.
                 -> Code (ST s (Maybe a))  -- ^ The code that is executed when the captured offset matches the input.
                 -> DynHandler s o a       -- ^ The handler to be executed when offsets are known not to match.
                 -> StaHandler s o a       -- ^ A handler that carries this information around for later refinement.
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 WStaHandler# s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
-> StaHandler s o a
forall s o a.
Maybe (Offset o)
-> StaHandlerCase WStaHandler# s o a
-> Maybe (StaHandlerCase WDynHandler 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 WStaHandler# s o a
forall s o a.
StaHandler# s o a
-> Code (ST s (Maybe a))
-> StaHandler# s o a
-> StaHandlerCase WStaHandler# s o a
mkFullSta (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))
  (StaHandlerCase WDynHandler s o a
-> Maybe (StaHandlerCase WDynHandler s o a)
forall a. a -> Maybe a
Just (DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandlerCase WDynHandler s o a
forall s o a.
DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandlerCase WDynHandler s o a
mkFullDyn DynHandler s o a
handler Code (ST s (Maybe a))
yes DynHandler s o a
no))

{-|
Unlike `staHandler#`, which returns a handler that accepts @'Code' ('Rep' o)@, this
function accepts a full `Parsley.Internal.Backend.Machine.Types.Offset.Offset`,
which can be used to refine the outcome of the execution of the handler as follows:

  * If the handler has a registered captured offset, and these offsets are comparable:

      * If the offsets are equal, use the code to be executed on matching offset (See `mkStaHandlerFull`)
      * If the offsets are not equal, invoke the sub-handler, skipping the if check (see `mkStaHandlerFull`)

  * If the handler is missing a captured offset, or they are incomparable (from different sources)
     then execute the full handler, which will perform a runtime check for equivalence.

@since 1.4.0.0
-}
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 WStaHandler# s o a
sh Maybe (StaHandlerCase WDynHandler 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 (WStaHandler# s o a -> Code (Rep o) -> Code (ST s (Maybe a))
forall s o a. WStaHandler# s o a -> StaHandler# s o a
unWrapSta (StaHandlerCase WStaHandler# s o a -> WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase WStaHandler# 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 WStaHandler# s o a -> Maybe (Code (ST s (Maybe a)))
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> Maybe (Code (ST s (Maybe a)))
yesSame StaHandlerCase WStaHandler# 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           = WStaHandler# s o a -> Code (Rep o) -> Code (ST s (Maybe a))
forall s o a. WStaHandler# s o a -> StaHandler# s o a
unWrapSta (WStaHandler# s o a
-> Maybe (WStaHandler# s o a) -> WStaHandler# s o a
forall a. a -> Maybe a -> a
fromMaybe (StaHandlerCase WStaHandler# s o a -> WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase WStaHandler# s o a
sh) (StaHandlerCase WStaHandler# s o a -> Maybe (WStaHandler# s o a)
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> Maybe (h s o a)
notSame StaHandlerCase WStaHandler# 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 WStaHandler# s o a
sh Maybe (StaHandlerCase WDynHandler s o a)
_) Offset o
o = WStaHandler# s o a -> Code (Rep o) -> Code (ST s (Maybe a))
forall s o a. WStaHandler# s o a -> StaHandler# s o a
unWrapSta (StaHandlerCase WStaHandler# s o a -> WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase WStaHandler# s o a
sh) (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
o)

staHandlerCharacteristic :: StaHandlerCase h s o a -> (Code (ST s (Maybe a)) -> h s o a) -> InputCharacteristic -> h s o a
staHandlerCharacteristic :: StaHandlerCase h s o a
-> (Code (ST s (Maybe a)) -> h s o a)
-> InputCharacteristic
-> h s o a
staHandlerCharacteristic StaHandlerCase h s o a
sh Code (ST s (Maybe a)) -> h s o a
conv InputCharacteristic
NeverConsumes      = h s o a
-> (Code (ST s (Maybe a)) -> h s o a)
-> Maybe (Code (ST s (Maybe a)))
-> h s o a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (StaHandlerCase h s o a -> h s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase h s o a
sh) Code (ST s (Maybe a)) -> h s o a
conv (StaHandlerCase h s o a -> Maybe (Code (ST s (Maybe a)))
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> Maybe (Code (ST s (Maybe a)))
yesSame StaHandlerCase h s o a
sh)
staHandlerCharacteristic StaHandlerCase h s o a
sh Code (ST s (Maybe a)) -> h s o a
_    (AlwaysConsumes Maybe Word
_) = h s o a -> Maybe (h s o a) -> h s o a
forall a. a -> Maybe a -> a
fromMaybe (StaHandlerCase h s o a -> h s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase h s o a
sh) (StaHandlerCase h s o a -> Maybe (h s o a)
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> Maybe (h s o a)
notSame StaHandlerCase h s o a
sh)
staHandlerCharacteristic StaHandlerCase h s o a
sh Code (ST s (Maybe a)) -> h s o a
_    InputCharacteristic
MayConsume         = StaHandlerCase h s o a -> h s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a -> h s o a
unknown StaHandlerCase h s o a
sh

{-|
Selects the correct case out of a `StaHandlerCase` depending on what the `InputCharacteristic` that
governs the use of the handler is. This means that it can select any of the three cases.

@since 1.5.0.0
-}
staHandlerCharacteristicSta :: StaHandlerCase WStaHandler# s o a -> InputCharacteristic -> StaHandler# s o a
staHandlerCharacteristicSta :: StaHandlerCase WStaHandler# s o a
-> InputCharacteristic -> StaHandler# s o a
staHandlerCharacteristicSta StaHandlerCase WStaHandler# s o a
h = WStaHandler# s o a -> StaHandler# s o a
forall s o a. WStaHandler# s o a -> StaHandler# s o a
unWrapSta (WStaHandler# s o a -> StaHandler# s o a)
-> (InputCharacteristic -> WStaHandler# s o a)
-> InputCharacteristic
-> StaHandler# s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaHandlerCase WStaHandler# s o a
-> (Code (ST s (Maybe a)) -> WStaHandler# s o a)
-> InputCharacteristic
-> WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a
-> (Code (ST s (Maybe a)) -> h s o a)
-> InputCharacteristic
-> h s o a
staHandlerCharacteristic StaHandlerCase WStaHandler# s o a
h (StaHandler# s o a -> WStaHandler# s o a
forall s o a. StaHandler# s o a -> WStaHandler# s o a
WrapSta (StaHandler# s o a -> WStaHandler# s o a)
-> (Code (ST s (Maybe a)) -> StaHandler# s o a)
-> Code (ST s (Maybe a))
-> WStaHandler# s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code (ST s (Maybe a)) -> StaHandler# s o a
forall a b. a -> b -> a
const)

{-|
Selects the correct case out of a `StaHandlerCase` depending on what the `InputCharacteristic` that
governs the use of the handler is. This means that it can select any of the three cases.

@since 1.5.0.0
-}
staHandlerCharacteristicDyn :: StaHandlerCase WDynHandler s o a
                            -> (Code (ST s (Maybe a)) -> DynHandler s o a) -- ^ How to convert the input-same case to a `DynHandler`.
                            -> InputCharacteristic
                            -> DynHandler s o a
staHandlerCharacteristicDyn :: StaHandlerCase WDynHandler s o a
-> (Code (ST s (Maybe a)) -> DynHandler s o a)
-> InputCharacteristic
-> DynHandler s o a
staHandlerCharacteristicDyn StaHandlerCase WDynHandler s o a
h Code (ST s (Maybe a)) -> DynHandler s o a
conv = WDynHandler s o a -> DynHandler s o a
forall s o a. WDynHandler s o a -> DynHandler s o a
unWrapDyn (WDynHandler s o a -> DynHandler s o a)
-> (InputCharacteristic -> WDynHandler s o a)
-> InputCharacteristic
-> DynHandler s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaHandlerCase WDynHandler s o a
-> (Code (ST s (Maybe a)) -> WDynHandler s o a)
-> InputCharacteristic
-> WDynHandler s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
StaHandlerCase h s o a
-> (Code (ST s (Maybe a)) -> h s o a)
-> InputCharacteristic
-> h s o a
staHandlerCharacteristic StaHandlerCase WDynHandler s o a
h (DynHandler s o a -> WDynHandler s o a
forall s o a. DynHandler s o a -> WDynHandler s o a
WrapDyn (DynHandler s o a -> WDynHandler s o a)
-> (Code (ST s (Maybe a)) -> DynHandler s o a)
-> Code (ST s (Maybe a))
-> WDynHandler s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code (ST s (Maybe a)) -> DynHandler s o a
conv)

{-|
Represents potentially three handlers: one for unknown offset cases, one for offset known to be
the same, and another for offset known to be different (see `mkStaHandlerFull`). Parameterised by
a generic handler type, which is instantiated to one of `WStaHandler#` or `WDynHandler`.

@since 1.5.0.0
-}
data StaHandlerCase h s (o :: Type) a = StaHandlerCase {
  -- | The static function representing this handler when offsets are incomparable.
  StaHandlerCase h s o a -> h s o a
unknown :: h s o a,
  -- | The static value representing this handler when offsets are known to match, if available.
  StaHandlerCase h s o a -> Maybe (Code (ST s (Maybe a)))
yesSame :: Maybe (Code (ST s (Maybe a))),
  -- | The static function representing this handler when offsets are known not to match, if available.
  StaHandlerCase h s o a -> Maybe (h s o a)
notSame :: Maybe (h s o a)
}

{-|
Wraps a `StaHandler#`.

@since 1.5.0.0
-}
newtype WStaHandler# s o a = WrapSta { WStaHandler# s o a -> StaHandler# s o a
unWrapSta :: StaHandler# s o a }

{-|
Wraps a `DynHandler`.

@since 1.5.0.0
-}
newtype WDynHandler s o a = WrapDyn { WDynHandler s o a -> DynHandler s o a
unWrapDyn :: DynHandler s o a }

mkUnknown :: h s o a -> StaHandlerCase h s o a
mkUnknown :: h s o a -> StaHandlerCase h s o a
mkUnknown h s o a
h = h s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (h s o a)
-> StaHandlerCase h s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
h s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (h s o a)
-> StaHandlerCase h s o a
StaHandlerCase h s o a
h Maybe (Code (ST s (Maybe a)))
forall a. Maybe a
Nothing Maybe (h s o a)
forall a. Maybe a
Nothing

mkUnknownSta :: StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
mkUnknownSta :: StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
mkUnknownSta = WStaHandler# s o a -> StaHandlerCase WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
h s o a -> StaHandlerCase h s o a
mkUnknown (WStaHandler# s o a -> StaHandlerCase WStaHandler# s o a)
-> (StaHandler# s o a -> WStaHandler# s o a)
-> StaHandler# s o a
-> StaHandlerCase WStaHandler# s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaHandler# s o a -> WStaHandler# s o a
forall s o a. StaHandler# s o a -> WStaHandler# s o a
WrapSta

mkUnknownDyn :: DynHandler s o a -> StaHandlerCase WDynHandler s o a
mkUnknownDyn :: DynHandler s o a -> StaHandlerCase WDynHandler s o a
mkUnknownDyn = WDynHandler s o a -> StaHandlerCase WDynHandler s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
h s o a -> StaHandlerCase h s o a
mkUnknown (WDynHandler s o a -> StaHandlerCase WDynHandler s o a)
-> (DynHandler s o a -> WDynHandler s o a)
-> DynHandler s o a
-> StaHandlerCase WDynHandler s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynHandler s o a -> WDynHandler s o a
forall s o a. DynHandler s o a -> WDynHandler s o a
WrapDyn

mkFull :: h s o a -> Code (ST s (Maybe a)) -> h s o a -> StaHandlerCase h s o a
mkFull :: h s o a
-> Code (ST s (Maybe a)) -> h s o a -> StaHandlerCase h s o a
mkFull h s o a
h Code (ST s (Maybe a))
yes h s o a
no = h s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (h s o a)
-> StaHandlerCase h s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
h s o a
-> Maybe (Code (ST s (Maybe a)))
-> Maybe (h s o a)
-> StaHandlerCase h s o a
StaHandlerCase h 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) (h s o a -> Maybe (h s o a)
forall a. a -> Maybe a
Just h s o a
no)

mkFullSta :: StaHandler# s o a -> Code (ST s (Maybe a)) -> StaHandler# s o a -> StaHandlerCase WStaHandler# s o a
mkFullSta :: StaHandler# s o a
-> Code (ST s (Maybe a))
-> StaHandler# s o a
-> StaHandlerCase WStaHandler# s o a
mkFullSta StaHandler# s o a
h Code (ST s (Maybe a))
yes StaHandler# s o a
no = WStaHandler# s o a
-> Code (ST s (Maybe a))
-> WStaHandler# s o a
-> StaHandlerCase WStaHandler# s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
h s o a
-> Code (ST s (Maybe a)) -> h s o a -> StaHandlerCase h s o a
mkFull (StaHandler# s o a -> WStaHandler# s o a
forall s o a. StaHandler# s o a -> WStaHandler# s o a
WrapSta StaHandler# s o a
h) Code (ST s (Maybe a))
yes (StaHandler# s o a -> WStaHandler# s o a
forall s o a. StaHandler# s o a -> WStaHandler# s o a
WrapSta StaHandler# s o a
no)

mkFullDyn :: DynHandler s o a -> Code (ST s (Maybe a)) -> DynHandler s o a -> StaHandlerCase WDynHandler s o a
mkFullDyn :: DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandlerCase WDynHandler s o a
mkFullDyn DynHandler s o a
h Code (ST s (Maybe a))
yes DynHandler s o a
no = WDynHandler s o a
-> Code (ST s (Maybe a))
-> WDynHandler s o a
-> StaHandlerCase WDynHandler s o a
forall (h :: Type -> Type -> Type -> Type) s o a.
h s o a
-> Code (ST s (Maybe a)) -> h s o a -> StaHandlerCase h s o a
mkFull (DynHandler s o a -> WDynHandler s o a
forall s o a. DynHandler s o a -> WDynHandler s o a
WrapDyn DynHandler s o a
h) Code (ST s (Maybe a))
yes (DynHandler s o a -> WDynHandler s o a
forall s o a. DynHandler s o a -> WDynHandler s o a
WrapDyn DynHandler s o a
no)

-- Continuations
{-|
This represents the translation of `Parsley.Internal.Backend.Machine.Types.Base.Cont#`
but where the static function structure has been exposed. This allows for β-reduction
on continuations, a simple form of inlining optimisation.

@since 1.4.0.0
-}
type StaCont# s o a x = Code x -> Code (Rep o) -> Code (ST s (Maybe a))

{-|
Compared with `StaCont#`, this type also bundles the static continuation
with its dynamic origin, if available.

@since 1.4.0.0
-}
data StaCont s o a x = StaCont (StaCont# s o a x) (Maybe (DynCont s o a x))

{-|
Converts a `Parsley.Internal.Machine.Types.Dynamics.DynCont` into a
`StaCont`. The dynamic continuation used to construct this
static continuation is maintained as the origin of the continuation. This means
if it is converted back the conversion is free.

@since 1.4.0.0
-}
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)

{-|
Given a static continuation, extracts the underlying continuation which
has "forgotten" any static domain-specific information it had been
attached to.

@since 1.4.0.0
-}
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

{-|
Wraps a `StaCont#` up, under the knowledge that it is purely static and
not derived from any dynamic continuation.

@since 1.4.0.0
-}
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

-- Subroutines
{-|
This represents the translation of `Parsley.Internal.Backend.Machine.Types.Base.Subroutine#`
but where the static function structure has been exposed. This allows for β-reduction
on subroutines, a simple form of inlining optimisation: useful for iteration.

@since 1.5.0.0
-}
type StaSubroutine# s o a x = DynCont s o a x -> Code (Rep o) -> DynHandler s o a -> Code (ST s (Maybe a))

{-|
Packages a `StaSubroutine#` along with statically determined metadata that describes it derived from
static analysis.

@since 1.5.0.0
-}
data StaSubroutine s o a x = StaSubroutine {
    -- | Extracts the underlying subroutine.
    StaSubroutine s o a x -> StaSubroutine# s o a x
staSubroutine# :: StaSubroutine# s o a x,
    -- | Extracts the metadata from a subroutine.
    StaSubroutine s o a x -> Metadata
meta :: Metadata
  }

{-|
Converts a `StaSubroutine#` into a `StaSubroutine` by providing the empty meta.

@since 1.5.0.0
-}
mkStaSubroutine :: StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutine :: StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutine = Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
forall s o a x.
Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutineMeta Metadata
newMeta

{-|
Converts a `StaSubroutine#` into a `StaSubroutine` by providing its metadata.

@since 1.5.0.0
-}
mkStaSubroutineMeta :: Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutineMeta :: Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
mkStaSubroutineMeta = (StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x)
-> Metadata -> StaSubroutine# s o a x -> StaSubroutine s o a x
forall a b c. (a -> b -> c) -> b -> a -> c
flip StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x
forall s o a x.
StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x
StaSubroutine

{-|
This represents the translation of `Parsley.Internal.Backend.Machine.Types.Base.Func`
but where the static function structure has been exposed. This allows for β-reduction
on subroutines with registers, a simple form of inlining optimisation.

@since 1.4.0.0
-}
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

{-|
Wraps a `StaFunc` with its free registers, which are kept existential.

@since 1.4.0.0
-}
data QSubroutine s o a x = forall rs. QSubroutine (StaFunc rs s o a x) (Regs rs)

{-|
Converts a `Parsley.Internal.Backend.Machine.Types.Dynamics.DynFunc` that relies
on zero or more free registers into a `QSubroutine`, where the registers are
existentially bounds to the function.

@since 1.5.0.0
-}
qSubroutine :: forall s o a x rs. DynFunc rs s o a x -> Regs rs -> Metadata -> QSubroutine s o a x
qSubroutine :: 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 = 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 = StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x
forall s o a x.
StaSubroutine# s o a x -> Metadata -> StaSubroutine s o a x
StaSubroutine (\DynCont s o a x
dk Code (Rep o)
o# DynHandler s o a
dh -> [|| $$func $$dk $$(o#) $$dh ||]) Metadata
meta
    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 ||]