{-# LANGUAGE StandaloneKindSignatures, TypeApplications #-} module Parsley.Internal.Backend.Machine.Defunc (module Parsley.Internal.Backend.Machine.Defunc) where import Data.Proxy (Proxy(Proxy)) import Parsley.Internal.Backend.Machine.InputOps (PositionOps(same)) import Parsley.Internal.Backend.Machine.InputRep (Rep) import Parsley.Internal.Common.Utils (Code, WQ(WQ)) import qualified Parsley.Internal.Core.Defunc as Core (Defunc(BLACK), ap, genDefunc, genDefunc1, genDefunc2) data Defunc a where USER :: Core.Defunc a -> Defunc a BOTTOM :: Defunc a SAME :: PositionOps o => Defunc (o -> o -> Bool) FREEVAR :: Code a -> Defunc a OFFSET :: Code (Rep o) -> Defunc o ap2 :: Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c ap2 :: Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c ap2 f :: Defunc (a -> b -> c) f@Defunc (a -> b -> c) SAME (OFFSET Code (Rep a) o1) (OFFSET Code (Rep b) o2) = Defunc Bool -> Defunc Bool forall a. Defunc a -> Defunc a USER (Code Bool -> Defunc Bool forall a. Code a -> Defunc a black (Defunc (a -> a -> Bool) -> Code (Rep a) -> Code (Rep a) -> Code Bool forall o. Defunc (o -> o -> Bool) -> Code (Rep o) -> Code (Rep o) -> Code Bool apSame Defunc (a -> a -> Bool) Defunc (a -> b -> c) f Code (Rep a) o1 Code (Rep a) Code (Rep b) o2)) where apSame :: forall o. Defunc (o -> o -> Bool) -> Code (Rep o) -> Code (Rep o) -> Code Bool apSame :: Defunc (o -> o -> Bool) -> Code (Rep o) -> Code (Rep o) -> Code Bool apSame Defunc (o -> o -> Bool) SAME = Proxy o -> Code (Rep o) -> Code (Rep o) -> Code Bool forall input (rep :: TYPE (RepKind input)). (PositionOps input, rep ~ Rep input) => Proxy input -> Code rep -> Code rep -> Code Bool same (Proxy o forall k (t :: k). Proxy t Proxy @o) apSame Defunc (o -> o -> Bool) _ = Code (Rep o) -> Code (Rep o) -> Code Bool forall a. HasCallStack => a undefined ap2 Defunc (a -> b -> c) f Defunc a x Defunc b y = Defunc c -> Defunc c forall a. Defunc a -> Defunc a USER (Defunc (b -> c) -> Defunc b -> Defunc c forall a b. Defunc (a -> b) -> Defunc a -> Defunc b Core.ap (Defunc (a -> b -> c) -> Defunc a -> Defunc (b -> c) forall a b. Defunc (a -> b) -> Defunc a -> Defunc b Core.ap (Defunc (a -> b -> c) -> Defunc (a -> b -> c) forall a. Defunc a -> Defunc a seal Defunc (a -> b -> c) f) (Defunc a -> Defunc a forall a. Defunc a -> Defunc a seal Defunc a x)) (Defunc b -> Defunc b forall a. Defunc a -> Defunc a seal Defunc b y)) where seal :: Defunc a -> Core.Defunc a seal :: Defunc a -> Defunc a seal (USER Defunc a x) = Defunc a x seal Defunc a x = Code a -> Defunc a forall a. Code a -> Defunc a black (Defunc a -> Code a forall a. Defunc a -> Code a genDefunc Defunc a x) black :: Code a -> Core.Defunc a black :: Code a -> Defunc a black = WQ a -> Defunc a forall a. WQ a -> Defunc a Core.BLACK (WQ a -> Defunc a) -> (Code a -> WQ a) -> Code a -> Defunc a forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Code a -> WQ a forall a. a -> Code a -> WQ a WQ a forall a. HasCallStack => a undefined genDefunc :: Defunc a -> Code a genDefunc :: Defunc a -> Code a genDefunc (USER Defunc a x) = Defunc a -> Code a forall a. Defunc a -> Code a Core.genDefunc Defunc a x genDefunc Defunc a BOTTOM = [||undefined||] genDefunc (FREEVAR Code a x) = Code a x genDefunc Defunc a SAME = [Char] -> Code a forall a. HasCallStack => [Char] -> a error [Char] "Cannot materialise the same function in the regular way" genDefunc (OFFSET Code (Rep a) _) = [Char] -> Code a forall a. HasCallStack => [Char] -> a error [Char] "Cannot materialise an unboxed offset in the regular way" genDefunc1 :: Defunc (a -> b) -> Code a -> Code b genDefunc1 :: Defunc (a -> b) -> Code a -> Code b genDefunc1 (USER Defunc (a -> b) f) Code a qx = Defunc (a -> b) -> Code a -> Code b forall a b. Defunc (a -> b) -> Code a -> Code b Core.genDefunc1 Defunc (a -> b) f Code a qx genDefunc1 Defunc (a -> b) f Code a qx = [|| $$(genDefunc f) $$qx ||] genDefunc2 :: Defunc (a -> b -> c) -> Code a -> Code b -> Code c genDefunc2 :: Defunc (a -> b -> c) -> Code a -> Code b -> Code c genDefunc2 (USER Defunc (a -> b -> c) f) Code a qx Code b qy = Defunc (a -> b -> c) -> Code a -> Code b -> Code c forall a b c. Defunc (a -> b -> c) -> Code a -> Code b -> Code c Core.genDefunc2 Defunc (a -> b -> c) f Code a qx Code b qy genDefunc2 Defunc (a -> b -> c) f Code a qx Code b qy = [|| $$(genDefunc f) $$qx $$qy ||] instance Show (Defunc a) where show :: Defunc a -> [Char] show (USER Defunc a x) = Defunc a -> [Char] forall a. Show a => a -> [Char] show Defunc a x show Defunc a SAME = [Char] "same" show Defunc a BOTTOM = [Char] "[[irrelevant]]" show (FREEVAR Code a _) = [Char] "x" show (OFFSET Code (Rep a) _) = [Char] "an offset"