{-# LANGUAGE PatternSynonyms #-}
module Parsley.Internal.Backend.Machine.LetBindings (
LetBinding(..), Metadata, InputCharacteristic(..),
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.Common (Fix4, One)
type Binding o a x = Fix4 (Instr o) '[] One x a
data LetBinding o a x = LetBinding {
LetBinding o a x -> Binding o a x
body :: Binding o a x,
LetBinding o a x -> Some Regs
freeRegs :: Some Regs,
LetBinding o a x -> Metadata
meta :: Metadata
}
data Metadata = Metadata {
Metadata -> InputCharacteristic
successInputCharacteristic :: InputCharacteristic,
Metadata -> InputCharacteristic
failureInputCharacteristic :: InputCharacteristic
}
data InputCharacteristic = AlwaysConsumes (Maybe Word)
| NeverConsumes
| MayConsume
makeLetBinding :: Binding o a x -> Set SomeΣVar -> Metadata -> LetBinding o a x
makeLetBinding :: Binding o a x -> Set SomeΣVar -> Metadata -> LetBinding o a x
makeLetBinding Binding o a x
m Set SomeΣVar
rs = Binding o a x -> Some Regs -> Metadata -> LetBinding o a x
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 :: InputCharacteristic -> InputCharacteristic -> Metadata
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 = (SomeΣVar -> Some Regs -> Some Regs)
-> Some Regs -> Set SomeΣVar -> Some Regs
forall a b. (a -> b -> b) -> b -> Set a -> b
foldr (\(SomeΣVar ΣVar r
σ) (Some rs) -> Regs (r : a) -> Some Regs
forall k (tag :: k -> Type) (a :: k). tag a -> Some tag
Some (ΣVar r -> Regs a -> Regs (r : a)
forall r (rs :: [Type]). ΣVar r -> Regs rs -> Regs (r : rs)
FreeReg ΣVar r
σ Regs a
rs)) (Regs '[] -> Some Regs
forall k (tag :: k -> Type) (a :: k). tag a -> Some tag
Some Regs '[]
NoRegs)