{-# LANGUAGE ExistentialQuantification,
             StandaloneDeriving,
             DerivingStrategies #-}
module Parsley.Internal.Backend.Machine.LetBindings (
    LetBinding(..),
    Regs(..),
    makeLetBinding,
    Binding
  ) where

import Prelude hiding                                (foldr)
import Data.Kind                                     (Type)
import Data.Set                                      (Set, foldr)
import Parsley.Internal.Backend.Machine.Identifiers  (IΣVar, ΣVar(..))
import Parsley.Internal.Backend.Machine.Instructions (Instr)
import Parsley.Internal.Common                       (Fix4, One)
import Unsafe.Coerce                                 (unsafeCoerce)

type Binding o a x = Fix4 (Instr o) '[] One x a
data LetBinding o a x = forall rs. LetBinding (Binding o a x) (Regs rs)
deriving stock instance Show (LetBinding o a x)

makeLetBinding :: Binding o a x -> Set IΣVar -> LetBinding o a x
makeLetBinding :: Binding o a x -> Set IΣVar -> LetBinding o a x
makeLetBinding Binding o a x
m Set IΣVar
rs = Binding o a x -> Regs Any -> LetBinding o a x
forall rep (o :: rep) a x (rs :: [Type]).
Binding o a x -> Regs rs -> LetBinding o a x
LetBinding Binding o a x
m (Set IΣVar -> Regs Any
forall (rs :: [Type]). Set IΣVar -> Regs rs
unsafeMakeRegs Set IΣVar
rs)

data Regs (rs :: [Type]) where
  NoRegs :: Regs '[]
  FreeReg :: ΣVar r -> Regs rs -> Regs (r : rs)
deriving stock instance Show (Regs rs)

unsafeMakeRegs :: Set IΣVar -> Regs rs
unsafeMakeRegs :: Set IΣVar -> Regs rs
unsafeMakeRegs =  (IΣVar -> Regs rs -> Regs rs) -> Regs rs -> Set IΣVar -> Regs rs
forall a b. (a -> b -> b) -> b -> Set a -> b
foldr (\IΣVar
σ Regs rs
rs -> Regs (Any : rs) -> Regs rs
forall a b. a -> b
unsafeCoerce (ΣVar Any -> Regs rs -> Regs (Any : rs)
forall r (rs :: [Type]). ΣVar r -> Regs rs -> Regs (r : rs)
FreeReg (IΣVar -> ΣVar Any
forall a. IΣVar -> ΣVar a
ΣVar IΣVar
σ) Regs rs
rs)) (Regs '[] -> Regs rs
forall a b. a -> b
unsafeCoerce Regs '[]
NoRegs)