{-# LANGUAGE PatternSynonyms #-}
module Parsley.Internal.Backend.Machine.LetBindings (
LetBinding(..), Metadata,
Regs(..),
makeLetBinding, newMeta,
successInputCharacteristic, failureInputCharacteristic,
Binding
) where
import Prelude hiding (foldr)
import Data.Kind (Type)
import Data.Set (Set, foldr)
import Data.Some (Some, pattern Some)
import Parsley.Internal.Backend.Machine.Identifiers (ΣVar, SomeΣVar(..))
import Parsley.Internal.Backend.Machine.Instructions (Instr)
import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic(..))
import Parsley.Internal.Common (Fix4, One)
type Binding o a x = Fix4 (Instr o) '[] One x a
data LetBinding o a x = LetBinding {
forall o a x. LetBinding o a x -> Binding o a x
body :: Binding o a x,
forall o a x. LetBinding o a x -> Some Regs
freeRegs :: Some Regs,
forall o a x. LetBinding o a x -> Metadata
meta :: Metadata
}
data Metadata = Metadata {
Metadata -> InputCharacteristic
successInputCharacteristic :: !InputCharacteristic,
Metadata -> InputCharacteristic
failureInputCharacteristic :: !InputCharacteristic
}
makeLetBinding :: Binding o a x -> Set SomeΣVar -> Metadata -> LetBinding o a x
makeLetBinding :: forall o a x.
Binding o a x -> Set SomeΣVar -> Metadata -> LetBinding o a x
makeLetBinding Binding o a x
m Set SomeΣVar
rs = forall o a x.
Binding o a x -> Some Regs -> Metadata -> LetBinding o a x
LetBinding Binding o a x
m (Set SomeΣVar -> Some Regs
makeRegs Set SomeΣVar
rs)
newMeta :: Metadata
newMeta :: Metadata
newMeta = Metadata {
successInputCharacteristic :: InputCharacteristic
successInputCharacteristic = InputCharacteristic
MayConsume,
failureInputCharacteristic :: InputCharacteristic
failureInputCharacteristic = InputCharacteristic
MayConsume
}
data Regs (rs :: [Type]) where
NoRegs :: Regs '[]
FreeReg :: ΣVar r -> Regs rs -> Regs (r : rs)
makeRegs :: Set SomeΣVar -> Some Regs
makeRegs :: Set SomeΣVar -> Some Regs
makeRegs = forall a b. (a -> b -> b) -> b -> Set a -> b
foldr (\(SomeΣVar ΣVar r
σ) (Some Regs a
rs) -> forall {k} (tag :: k -> Type) (a :: k). tag a -> Some tag
Some (forall r (rs :: [Type]). ΣVar r -> Regs rs -> Regs (r : rs)
FreeReg ΣVar r
σ Regs a
rs)) (forall {k} (tag :: k -> Type) (a :: k). tag a -> Some tag
Some Regs '[]
NoRegs)