{-# LANGUAGE CPP #-} module Parsley.Internal.Backend.Machine.THUtils (eta, unsafeCodeCoerce, unTypeCode) where import GHC.Types (TYPE) #if __GLASGOW_HASKELL__ < 900 import Language.Haskell.TH.Syntax (Q, unTypeQ, unsafeTExpCoerce #else import Language.Haskell.TH.Syntax (unTypeCode, unsafeCodeCoerce #endif , Exp(AppE, LamE, VarE), Pat(VarP, BangP, SigP)) import Parsley.Internal.Common.Utils (Code) eta :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). Code (a -> b) -> Code (a -> b) eta :: Code (a -> b) -> Code (a -> b) eta = Q Exp -> Code (a -> b) forall a. Q Exp -> Code a unsafeCodeCoerce (Q Exp -> Code (a -> b)) -> (Code (a -> b) -> Q Exp) -> Code (a -> b) -> Code (a -> b) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Exp -> Exp) -> Q Exp -> Q Exp forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b fmap Exp -> Exp checkEta (Q Exp -> Q Exp) -> (Code (a -> b) -> Q Exp) -> Code (a -> b) -> Q Exp forall b c a. (b -> c) -> (a -> b) -> a -> c . Code (a -> b) -> Q Exp forall a. Code a -> Q Exp unTypeCode where checkEta :: Exp -> Exp checkEta (LamE [VarP Name x] (AppE Exp qf (VarE Name x'))) | Name x Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name x' = Exp qf checkEta (LamE [SigP (VarP Name x) Type _] (AppE Exp qf (VarE Name x'))) | Name x Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name x' = Exp qf checkEta (LamE [BangP (VarP Name x)] (AppE Exp qf (VarE Name x'))) | Name x Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name x' = Exp qf checkEta (LamE [BangP (SigP (VarP Name x) Type _)] (AppE Exp qf (VarE Name x'))) | Name x Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name x' = Exp qf checkEta Exp qf = Exp qf #if __GLASGOW_HASKELL__ < 900 unsafeCodeCoerce :: Q Exp -> Code a unsafeCodeCoerce :: Q Exp -> Code a unsafeCodeCoerce = Q Exp -> Code a forall a. Q Exp -> Q (TExp a) unsafeTExpCoerce unTypeCode :: Code a -> Q Exp unTypeCode :: Code a -> Q Exp unTypeCode = Code a -> Q Exp forall a. Q (TExp a) -> Q Exp unTypeQ #endif