{-# 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