    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}

    {-|
    Module:      Data.Ord.Deriving.Internal
    Copyright:   (C) 2015-2017 Ryan Scott
    License:     BSD-style (see the file LICENSE)
    Maintainer:  Ryan Scott
    Portability: Template Haskell

    Exports functions to mechanically derive 'Ord', 'Ord1', and 'Ord2' instances.

    Note: this is an internal module, and as such, the API presented here is not
    guaranteed to be stable, even between minor releases of this library.
    -}
    module Data.Ord.Deriving.Internal (
          -- * 'Ord'
          deriveOrd
        , makeCompare
        , makeLE
        , makeLT
        , makeGT
        , makeGE
        , makeMax
        , makeMin
          -- * 'Ord1'
        , deriveOrd1
    #if defined(NEW_FUNCTOR_CLASSES)
        , makeLiftCompare
    #endif
        , makeCompare1
    #if defined(NEW_FUNCTOR_CLASSES)
          -- * 'Ord2'
        , deriveOrd2
        , makeLiftCompare2
        , makeCompare2
    #endif
        ) where

    import           Data.Deriving.Internal
    import           Data.List (partition)
    import qualified Data.List.NonEmpty as NE
    import           Data.List.NonEmpty (NonEmpty(..))
    import qualified Data.Map as Map
    import           Data.Map (Map)

    import           Language.Haskell.TH.Datatype
    import           Language.Haskell.TH.Lib
    import           Language.Haskell.TH.Syntax

    -- | Generates an 'Ord' instance declaration for the given data type or data
    -- family instance.
    deriveOrd :: Name -> Q [Dec]
    deriveOrd :: Name -> Q [Dec]
    deriveOrd = OrdClass -> Name -> Q [Dec]
    deriveOrdClass OrdClass
    Ord

    -- | Generates a lambda expression which behaves like 'compare' (without
    -- requiring an 'Ord' instance).
    makeCompare :: Name -> Q Exp
    makeCompare :: Name -> Q Exp
    makeCompare = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    OrdCompare ([Char] -> [Q Match]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "This shouldn't happen")

    -- | Generates a lambda expression which behaves like '(<)' (without
    -- requiring an 'Ord' instance).
    makeLT :: Name -> Q Exp
    makeLT :: Name -> Q Exp
    makeLT = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    OrdLT [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    ltDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    trueDataName)  []
                              , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP                (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    falseDataName) []
                              ]

    -- | Generates a lambda expression which behaves like '(<=)' (without
    -- requiring an 'Ord' instance).
    makeLE :: Name -> Q Exp
    makeLE :: Name -> Q Exp
    makeLE = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    OrdLE [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    gtDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    falseDataName) []
                              , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP                (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    trueDataName)  []
                              ]

    -- | Generates a lambda expression which behaves like '(>)' (without
    -- requiring an 'Ord' instance).
    makeGT :: Name -> Q Exp
    makeGT :: Name -> Q Exp
    makeGT = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    OrdGT [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    gtDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    trueDataName)  []
                              , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP                (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    falseDataName) []
                              ]

    -- | Generates a lambda expression which behaves like '(>=)' (without
    -- requiring an 'Ord' instance).
    makeGE :: Name -> Q Exp
    makeGE :: Name -> Q Exp
    makeGE = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    OrdGE [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    ltDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    falseDataName) []
                              , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP                (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    trueDataName)  []
                              ]

    -- | Generates a lambda expression which behaves like 'max' (without
    -- requiring an 'Ord' instance).
    makeMax :: Name -> Q Exp
    makeMax :: Name -> Q Exp
    makeMax = ((Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp)
    -> Name -> Q Exp
    makeMinMax (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip

    -- | Generates a lambda expression which behaves like 'min' (without
    -- requiring an 'Ord' instance).
    makeMin :: Name -> Q Exp
    makeMin :: Name -> Q Exp
    makeMin = ((Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp)
    -> Name -> Q Exp
    makeMinMax (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp
    forall a. a -> a
    id

    makeMinMax :: ((Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp)
               -> Name -> Q Exp
    makeMinMax :: ((Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp)
    -> Name -> Q Exp
    makeMinMax (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp
    f Name
    name = do
        Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
        Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
        let xExpr :: Q Exp
    xExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x
            yExpr :: Q Exp
    yExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y
        [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    x, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
            (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp
    f (Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    condE (Q Exp -> Q Exp -> Q Exp -> Q Exp)
    -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Exp
    makeLE Name
    name Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    xExpr Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    yExpr) Q Exp
    xExpr Q Exp
    yExpr

    -- | Generates an 'Ord1' instance declaration for the given data type or data
    -- family instance.
    deriveOrd1 :: Name -> Q [Dec]
    deriveOrd1 :: Name -> Q [Dec]
    deriveOrd1 = OrdClass -> Name -> Q [Dec]
    deriveOrdClass OrdClass
    Ord1

    #if defined(NEW_FUNCTOR_CLASSES)
    -- | Generates a lambda expression which behaves like 'liftCompare' (without
    -- requiring an 'Ord1' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftCompare :: Name -> Q Exp
    makeLiftCompare :: Name -> Q Exp
    makeLiftCompare = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    Ord1LiftCompare ([Char] -> [Q Match]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "This shouldn't happen")

    -- | Generates a lambda expression which behaves like 'compare1' (without
    -- requiring an 'Ord1' instance).
    makeCompare1 :: Name -> Q Exp
    makeCompare1 :: Name -> Q Exp
    makeCompare1 Name
    name = Name -> Q Exp
    makeLiftCompare Name
    name Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    compareValName
    #else
    -- | Generates a lambda expression which behaves like 'compare1' (without
    -- requiring an 'Ord1' instance).
    makeCompare1 :: Name -> Q Exp
    makeCompare1 = makeOrdFun Ord1Compare1 (error "This shouldn't happen")
    #endif

    #if defined(NEW_FUNCTOR_CLASSES)
    -- | Generates an 'Ord2' instance declaration for the given data type or data
    -- family instance.
    --
    -- This function is not available with @transformers-0.4@.
    deriveOrd2 :: Name -> Q [Dec]
    deriveOrd2 :: Name -> Q [Dec]
    deriveOrd2 = OrdClass -> Name -> Q [Dec]
    deriveOrdClass OrdClass
    Ord2

    -- | Generates a lambda expression which behaves like 'liftCompare2' (without
    -- requiring an 'Ord2' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeLiftCompare2 :: Name -> Q Exp
    makeLiftCompare2 :: Name -> Q Exp
    makeLiftCompare2 = OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    Ord2LiftCompare2 ([Char] -> [Q Match]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "This shouldn't happen")

    -- | Generates a lambda expression which behaves like 'compare2' (without
    -- requiring an 'Ord2' instance).
    --
    -- This function is not available with @transformers-0.4@.
    makeCompare2 :: Name -> Q Exp
    makeCompare2 :: Name -> Q Exp
    makeCompare2 Name
    name = Name -> Q Exp
    makeLiftCompare Name
    name
                 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    compareValName
                 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    compareValName
    #endif

    -------------------------------------------------------------------------------
    -- Code generation
    -------------------------------------------------------------------------------

    -- | Derive an Ord(1)(2) instance declaration (depending on the OrdClass
    -- argument's value).
    deriveOrdClass :: OrdClass -> Name -> Q [Dec]
    deriveOrdClass :: OrdClass -> Name -> Q [Dec]
    deriveOrdClass OrdClass
    oClass Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTypes
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          (Cxt
    instanceCxt, Type
    instanceType)
              <- OrdClass -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    forall a.
    ClassRep a =>
    a -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance OrdClass
    oClass Name
    parentName Cxt
    ctxt Cxt
    instTypes DatatypeVariant
    variant
          (Dec -> [Dec] -> [Dec]
    forall a. a -> [a] -> [a]
    :[]) (Dec -> [Dec]) -> Q Dec -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Q Cxt -> Q Type -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Cxt -> m Type -> [m Dec] -> m Dec
    instanceD (Cxt -> Q Cxt
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Cxt
    instanceCxt)
                                 (Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    instanceType)
                                 (OrdClass -> Cxt -> [ConstructorInfo] -> [Q Dec]
    ordFunDecs OrdClass
    oClass Cxt
    instTypes [ConstructorInfo]
    cons)

    -- | Generates a declaration defining the primary function(s) corresponding to a
    -- particular class (compare for Ord, liftCompare for Ord1, and
    -- liftCompare2 for Ord2).
    ordFunDecs :: OrdClass -> [Type] -> [ConstructorInfo] -> [Q Dec]
    ordFunDecs :: OrdClass -> Cxt -> [ConstructorInfo] -> [Q Dec]
    ordFunDecs OrdClass
    oClass Cxt
    instTypes [ConstructorInfo]
    cons =
        (OrdFun -> Q Dec) -> [OrdFun] -> [Q Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map OrdFun -> Q Dec
    makeFunD ([OrdFun] -> [Q Dec]) -> [OrdFun] -> [Q Dec]
    forall a b. (a -> b) -> a -> b
    $ OrdClass -> OrdFun
    ordClassToCompare OrdClass
    oClass OrdFun -> [OrdFun] -> [OrdFun]
    forall a. a -> [a] -> [a]
    : OrdClass -> [ConstructorInfo] -> [OrdFun]
    otherFuns OrdClass
    oClass [ConstructorInfo]
    cons
      where
        makeFunD :: OrdFun -> Q Dec
        makeFunD :: OrdFun -> Q Dec
    makeFunD OrdFun
    oFun =
          Name -> [Q Clause] -> Q Dec
    forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
    funD (OrdFun -> Int -> Name
    ordFunName OrdFun
    oFun (Int -> Name) -> Int -> Name
    forall a b. (a -> b) -> a -> b
    $ OrdClass -> Int
    forall a. ClassRep a => a -> Int
    arity OrdClass
    oClass)
               [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
    forall (m :: * -> *).
    Quote m =>
    [m Pat] -> m Body -> [m Dec] -> m Clause
    clause []
                        (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    dispatchFun OrdFun
    oFun)
                        []
               ]

        negateExpr :: Q Exp -> Q Exp
        negateExpr :: Q Exp -> Q Exp
    negateExpr = Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    notValName)

        dispatchLT :: (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
        dispatchLT :: (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    dispatchLT Q Exp -> Q Exp -> Q Exp -> Q Exp
    f = do
            Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
            Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
            [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    x, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Q Exp -> Q Exp -> Q Exp
    f (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    ltValName) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y)

        dispatchFun :: OrdFun -> Q Exp
        dispatchFun :: OrdFun -> Q Exp
    dispatchFun OrdFun
    oFun | OrdFun
    oFun OrdFun -> [OrdFun] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ OrdFun
    OrdCompare, OrdFun
    OrdLT
                                         -- OrdLT is included to mirror the fix to
                                         -- GHC Trac #10858.
    #if defined(NEW_FUNCTOR_CLASSES)
                                       , OrdFun
    Ord1LiftCompare, OrdFun
    Ord2LiftCompare2
    #else
                                       , Ord1Compare1
    #endif
                                       ]
                          = OrdFun -> Cxt -> [ConstructorInfo] -> Q Exp
    makeOrdFunForCons OrdFun
    oFun Cxt
    instTypes [ConstructorInfo]
    cons
        dispatchFun OrdFun
    OrdLE = (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    dispatchLT ((Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp)
    -> (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Q Exp
    lt Q Exp
    x Q Exp
    y -> Q Exp -> Q Exp
    negateExpr (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp
    lt Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    y Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    x
        dispatchFun OrdFun
    OrdGT = (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    dispatchLT ((Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp)
    -> (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Q Exp
    lt Q Exp
    x Q Exp
    y ->              Q Exp
    lt Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    y Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    x
        dispatchFun OrdFun
    OrdGE = (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    dispatchLT ((Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp)
    -> (Q Exp -> Q Exp -> Q Exp -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Q Exp
    lt Q Exp
    x Q Exp
    y -> Q Exp -> Q Exp
    negateExpr (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp
    lt Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    x Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    y
        dispatchFun OrdFun
    _     = [Char] -> Q Exp
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "ordFunDecs"

    -- | Generates a lambda expression which behaves like the OrdFun value. This
    -- function uses heuristics to determine whether to implement the OrdFun from
    -- scratch or define it in terms of compare.
    makeOrdFun :: OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun :: OrdFun -> [Q Match] -> Name -> Q Exp
    makeOrdFun OrdFun
    oFun [Q Match]
    matches Name
    name = do
      DatatypeInfo
    info <- Name -> Q DatatypeInfo
    reifyDatatype Name
    name
      case DatatypeInfo
    info of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    ctxt
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    parentName
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    instTypes
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     } -> do
          let oClass :: OrdClass
    oClass = OrdFun -> OrdClass
    ordFunToClass OrdFun
    oFun
              others :: [OrdFun]
    others = OrdClass -> [ConstructorInfo] -> [OrdFun]
    otherFuns OrdClass
    oClass [ConstructorInfo]
    cons
          -- We force buildTypeInstance here since it performs some checks for whether
          -- or not the provided datatype can actually have compare/liftCompare/etc.
          -- implemented for it, and produces errors if it can't.
          OrdClass -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    forall a.
    ClassRep a =>
    a -> Name -> Cxt -> Cxt -> DatatypeVariant -> Q (Cxt, Type)
    buildTypeInstance OrdClass
    oClass Name
    parentName Cxt
    ctxt Cxt
    instTypes DatatypeVariant
    variant Q (Cxt, Type) -> Q Exp -> Q Exp
    forall a b. Q a -> Q b -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
            if OrdFun
    oFun OrdFun -> [OrdFun] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [OrdFun]
    compareFuns Bool -> Bool -> Bool
    || OrdFun
    oFun OrdFun -> [OrdFun] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [OrdFun]
    others
               then OrdFun -> Cxt -> [ConstructorInfo] -> Q Exp
    makeOrdFunForCons OrdFun
    oFun Cxt
    instTypes [ConstructorInfo]
    cons
               else do
                 Name
    x <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "x"
                 Name
    y <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "y"
                 [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE [Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    x, Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    y] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                      Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (OrdFun -> Cxt -> [ConstructorInfo] -> Q Exp
    makeOrdFunForCons (OrdClass -> OrdFun
    ordClassToCompare OrdClass
    oClass) Cxt
    instTypes [ConstructorInfo]
    cons
                                 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    x Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    y)
                            [Q Match]
    matches
      where
        compareFuns :: [OrdFun]
        compareFuns :: [OrdFun]
    compareFuns = [ OrdFun
    OrdCompare
    #if defined(NEW_FUNCTOR_CLASSES)
                      , OrdFun
    Ord1LiftCompare
                      , OrdFun
    Ord2LiftCompare2
    #else
                      , Ord1Compare1
    #endif
                      ]

    -- | Generates a lambda expression for the given constructors.
    -- All constructors must be from the same type.
    makeOrdFunForCons :: OrdFun -> [Type] -> [ConstructorInfo] -> Q Exp
    makeOrdFunForCons :: OrdFun -> Cxt -> [ConstructorInfo] -> Q Exp
    makeOrdFunForCons OrdFun
    oFun Cxt
    instTypes [ConstructorInfo]
    cons = do
        let oClass :: OrdClass
    oClass = OrdFun -> OrdClass
    ordFunToClass OrdFun
    oFun
        Name
    v1     <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "v1"
        Name
    v2     <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "v2"
        Name
    v1Hash <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "v1#"
        Name
    v2Hash <- [Char] -> Q Name
    forall (m :: * -> *). Quote m => [Char] -> m Name
    newName [Char]
    "v2#"
        [Name]
    ords   <- [Char] -> Int -> Q [Name]
    newNameList [Char]
    "ord" (Int -> Q [Name]) -> Int -> Q [Name]
    forall a b. (a -> b) -> a -> b
    $ OrdClass -> Int
    forall a. ClassRep a => a -> Int
    arity OrdClass
    oClass

        let lastTyVars :: [Name]
            lastTyVars :: [Name]
    lastTyVars = (Type -> Name) -> Cxt -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Name
    varTToName (Cxt -> [Name]) -> Cxt -> [Name]
    forall a b. (a -> b) -> a -> b
    $ Int -> Cxt -> Cxt
    forall a. Int -> [a] -> [a]
    drop (Cxt -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    instTypes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - OrdClass -> Int
    forall a. Enum a => a -> Int
    fromEnum OrdClass
    oClass) Cxt
    instTypes

            tvMap :: TyVarMap1
            tvMap :: TyVarMap1
    tvMap = [(Name, OneOrTwoNames One)] -> TyVarMap1
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, OneOrTwoNames One)] -> TyVarMap1)
    -> [(Name, OneOrTwoNames One)] -> TyVarMap1
    forall a b. (a -> b) -> a -> b
    $ (Name -> Name -> (Name, OneOrTwoNames One))
    -> [Name] -> [Name] -> [(Name, OneOrTwoNames One)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Name
    x Name
    y -> (Name
    x, Name -> OneOrTwoNames One
    OneName Name
    y)) [Name]
    lastTyVars [Name]
    ords

            nullaryCons, nonNullaryCons :: [ConstructorInfo]
            ([ConstructorInfo]
    nullaryCons, [ConstructorInfo]
    nonNullaryCons) = (ConstructorInfo -> Bool)
    -> [ConstructorInfo] -> ([ConstructorInfo], [ConstructorInfo])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ConstructorInfo -> Bool
    isNullaryCon [ConstructorInfo]
    cons

            singleConType :: Bool
            singleConType :: Bool
    singleConType = [ConstructorInfo] -> Bool
    forall a. [a] -> Bool
    isSingleton [ConstructorInfo]
    cons

            -- Alternatively, we could look these up from dataConTagMap, but this
            -- is slightly faster due to the lack of Map lookups.
            firstTag, lastTag :: Int
            firstTag :: Int
    firstTag = Int
    0
            lastTag :: Int
    lastTag  = [ConstructorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    cons Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

            dataConTagMap :: Map Name Int
            dataConTagMap :: Map Name Int
    dataConTagMap = [(Name, Int)] -> Map Name Int
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Int)] -> Map Name Int) -> [(Name, Int)] -> Map Name Int
    forall a b. (a -> b) -> a -> b
    $ [Name] -> [Int] -> [(Name, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((ConstructorInfo -> Name) -> [ConstructorInfo] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ConstructorInfo -> Name
    constructorName [ConstructorInfo]
    cons) [Int
    0..]

            ordFunRhs :: Q Exp
            ordFunRhs :: Q Exp
    ordFunRhs =
              case [ConstructorInfo]
    cons of
                [] -> Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    eqDataName
                ConstructorInfo
    c:[ConstructorInfo]
    cs -> NonEmpty ConstructorInfo -> Q Exp
    ordFunRhsNonEmptyCons (ConstructorInfo
    c ConstructorInfo -> [ConstructorInfo] -> NonEmpty ConstructorInfo
    forall a. a -> [a] -> NonEmpty a
    :| [ConstructorInfo]
    cs)

            ordFunRhsNonEmptyCons :: NonEmpty ConstructorInfo -> Q Exp
            ordFunRhsNonEmptyCons :: NonEmpty ConstructorInfo -> Q Exp
    ordFunRhsNonEmptyCons cs :: NonEmpty ConstructorInfo
    cs@(ConstructorInfo
    c :| [ConstructorInfo]
    _)
              | [ConstructorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    nullaryCons Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    2
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v1) ([Q Match] -> Q Exp) -> [Q Match] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (ConstructorInfo -> Q Match) -> [ConstructorInfo] -> [Q Match]
    forall a b. (a -> b) -> [a] -> [b]
    map ConstructorInfo -> Q Match
    ordMatches ([ConstructorInfo] -> [Q Match]) -> [ConstructorInfo] -> [Q Match]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty ConstructorInfo -> [ConstructorInfo]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty ConstructorInfo
    cs
              | [ConstructorInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    nonNullaryCons
              = Q Exp
    mkTagCmp
              | Bool
    otherwise
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v1) ([Q Match] -> Q Exp) -> [Q Match] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (ConstructorInfo -> Q Match) -> [ConstructorInfo] -> [Q Match]
    forall a b. (a -> b) -> [a] -> [b]
    map ConstructorInfo -> Q Match
    ordMatches [ConstructorInfo]
    nonNullaryCons
                    [Q Match] -> [Q Match] -> [Q Match]
    forall a. [a] -> [a] -> [a]
    ++ [Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    mkTagCmp) []]
              where
                firstConName, lastConName :: Name
                firstConName :: Name
    firstConName = ConstructorInfo -> Name
    constructorName ConstructorInfo
    c
                lastConName :: Name
    lastConName  = ConstructorInfo -> Name
    constructorName (ConstructorInfo -> Name) -> ConstructorInfo -> Name
    forall a b. (a -> b) -> a -> b
    $ NonEmpty ConstructorInfo -> ConstructorInfo
    forall a. NonEmpty a -> a
    NE.last NonEmpty ConstructorInfo
    cs

                ordMatches :: ConstructorInfo -> Q Match
                ordMatches :: ConstructorInfo -> Q Match
    ordMatches = OrdFun
    -> Name
    -> Name
    -> TyVarMap1
    -> Bool
    -> Int
    -> Name
    -> Int
    -> Name
    -> Map Name Int
    -> ConstructorInfo
    -> Q Match
    makeOrdFunForCon OrdFun
    oFun Name
    v2 Name
    v2Hash TyVarMap1
    tvMap Bool
    singleConType
                                              Int
    firstTag Name
    firstConName Int
    lastTag Name
    lastConName
                                              Map Name Int
    dataConTagMap

            mkTagCmp :: Q Exp
            mkTagCmp :: Q Exp
    mkTagCmp = [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr [(Name
    v1, Name
    v1Hash), (Name
    v2, Name
    v2Hash)] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                           Name -> OrdFun -> Name -> Name -> Q Exp
    unliftedOrdFun Name
    intHashTypeName OrdFun
    oFun Name
    v1Hash Name
    v2Hash

        [Q Pat] -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
    lamE ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP ([Name] -> [Q Pat]) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> a -> b
    $
    #if defined(NEW_FUNCTOR_CLASSES)
                         [Name]
    ords [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++
    #endif
                         [Name
    v1, Name
    v2])
            (Q Exp -> Q Exp) -> ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE
            ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Name
    compareConstName OrdFun
    oFun
              , Q Exp
    ordFunRhs
              ]
    #if defined(NEW_FUNCTOR_CLASSES)
                [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Q Exp) -> [Name] -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE [Name]
    ords
    #endif
                [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ [Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v1, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2]

    makeOrdFunForCon :: OrdFun
                     -> Name
                     -> Name
                     -> TyVarMap1
                     -> Bool
                     -> Int -> Name
                     -> Int -> Name
                     -> Map Name Int
                     -> ConstructorInfo -> Q Match
    makeOrdFunForCon :: OrdFun
    -> Name
    -> Name
    -> TyVarMap1
    -> Bool
    -> Int
    -> Name
    -> Int
    -> Name
    -> Map Name Int
    -> ConstructorInfo
    -> Q Match
    makeOrdFunForCon OrdFun
    oFun Name
    v2 Name
    v2Hash TyVarMap1
    tvMap Bool
    singleConType
                     Int
    firstTag Name
    firstConName Int
    lastTag Name
    lastConName Map Name Int
    dataConTagMap
      (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName = Name
    conName, constructorFields :: ConstructorInfo -> Cxt
    constructorFields = Cxt
    ts }) = do
        Cxt
    ts' <- (Type -> Q Type) -> Cxt -> Q Cxt
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> Q Type
    resolveTypeSynonyms Cxt
    ts
        let tsLen :: Int
    tsLen = Cxt -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    ts'
        [Name]
    as <- [Char] -> Int -> Q [Name]
    newNameList [Char]
    "a" Int
    tsLen
        [Name]
    bs <- [Char] -> Int -> Q [Name]
    newNameList [Char]
    "b" Int
    tsLen

        let innerRhs :: Q Exp
            innerRhs :: Q Exp
    innerRhs
              | Bool
    singleConType
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [Q Match
    innerEqAlt]

              | Int
    tag Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    firstTag
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [Q Match
    innerEqAlt, Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    ltResult OrdFun
    oFun) []]

              | Int
    tag Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    lastTag
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [Q Match
    innerEqAlt, Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    gtResult OrdFun
    oFun) []]

              | Int
    tag Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    firstTag Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    recP Name
    firstConName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    gtResult OrdFun
    oFun) []
                                , Q Match
    innerEqAlt
                                , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    ltResult OrdFun
    oFun) []
                                ]

              | Int
    tag Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    lastTag Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
              = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q FieldPat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m FieldPat] -> m Pat
    recP Name
    lastConName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    ltResult OrdFun
    oFun) []
                                , Q Match
    innerEqAlt
                                , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    gtResult OrdFun
    oFun) []
                                ]

              | Int
    tag Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    lastTag Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
              = [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr [(Name
    v2, Name
    v2Hash)] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    condE (Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2Hash) Name
    ltIntHashValName Q Exp
    tagLit)
                      (OrdFun -> Q Exp
    gtResult OrdFun
    oFun) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [Q Match
    innerEqAlt, Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    ltResult OrdFun
    oFun) []]

              | Bool
    otherwise
              = [(Name, Name)] -> Q Exp -> Q Exp
    untagExpr [(Name
    v2, Name
    v2Hash)] (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    condE (Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2Hash) Name
    gtIntHashValName Q Exp
    tagLit)
                      (OrdFun -> Q Exp
    ltResult OrdFun
    oFun) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
                Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    v2) [Q Match
    innerEqAlt, Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Q Exp
    gtResult OrdFun
    oFun) []]

            innerEqAlt :: Q Match
            innerEqAlt :: Q Match
    innerEqAlt = Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    conName ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    bs)
                               (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> TyVarMap1 -> Name -> Cxt -> [Name] -> [Name] -> Q Exp
    makeOrdFunForFields OrdFun
    oFun TyVarMap1
    tvMap Name
    conName Cxt
    ts' [Name]
    as [Name]
    bs)
                               []

            tagLit :: Q Exp
            tagLit :: Q Exp
    tagLit = Lit -> Q Exp
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE (Lit -> Q Exp) -> (Integer -> Lit) -> Integer -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Lit
    intPrimL (Integer -> Q Exp) -> Integer -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    tag

        Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    conName ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ (Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    as)
              (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    innerRhs)
              []
      where
        tag :: Int
    tag = Map Name Int
    dataConTagMap Map Name Int -> Name -> Int
    forall k a. Ord k => Map k a -> k -> a
    Map.! Name
    conName

    makeOrdFunForFields :: OrdFun
                        -> TyVarMap1
                        -> Name
                        -> [Type]
                        -> [Name]
                        -> [Name]
                        -> Q Exp
    makeOrdFunForFields :: OrdFun -> TyVarMap1 -> Name -> Cxt -> [Name] -> [Name] -> Q Exp
    makeOrdFunForFields OrdFun
    oFun TyVarMap1
    tvMap Name
    conName = Cxt -> [Name] -> [Name] -> Q Exp
    go
      where
        go :: [Type] -> [Name] -> [Name] -> Q Exp
        go :: Cxt -> [Name] -> [Name] -> Q Exp
    go [] [Name]
    _ [Name]
    _ = OrdFun -> Q Exp
    eqResult OrdFun
    oFun
        go [Type
    ty] [Name
    a] [Name
    b]
          | Type -> Bool
    isSupportedUnliftedType Type
    ty = Name -> OrdFun -> Name -> Name -> Q Exp
    unliftedOrdFun (Type -> Name
    conTToName Type
    ty) OrdFun
    oFun Name
    a Name
    b
          | Bool
    otherwise = OrdFun -> TyVarMap1 -> Name -> Type -> Q Exp
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName Type
    ty
                            Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    a Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    b
        go (Type
    ty:Cxt
    tys) (Name
    a:[Name]
    as) (Name
    b:[Name]
    bs) =
            Type -> Name -> Name -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    mkCompare Type
    ty Name
    a Name
    b (OrdFun -> Q Exp
    ltResult OrdFun
    oFun) (Cxt -> [Name] -> [Name] -> Q Exp
    go Cxt
    tys [Name]
    as [Name]
    bs) (OrdFun -> Q Exp
    gtResult OrdFun
    oFun)
        go Cxt
    _ [Name]
    _ [Name]
    _ = [Char] -> Q Exp
    forall a. [Char] -> Q a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "Data.Ord.Deriving.Internal.makeOrdFunForFields"

        mkCompare :: Type -> Name -> Name -> Q Exp -> Q Exp -> Q Exp -> Q Exp
        mkCompare :: Type -> Name -> Name -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    mkCompare Type
    ty Name
    a Name
    b Q Exp
    lt Q Exp
    eq Q Exp
    gt
          | Type -> Bool
    isSupportedUnliftedType Type
    ty =
              let (Name
    ltFun, Name
    _, Name
    eqFun, Name
    _, Name
    _) = Name -> (Name, Name, Name, Name, Name)
    primOrdFuns (Name -> (Name, Name, Name, Name, Name))
    -> Name -> (Name, Name, Name, Name, Name)
    forall a b. (a -> b) -> a -> b
    $ Type -> Name
    conTToName Type
    ty
              in Name -> Name -> Q Exp -> Q Exp -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    unliftedCompare Name
    ltFun Name
    eqFun Q Exp
    aExpr Q Exp
    bExpr Q Exp
    lt Q Exp
    eq Q Exp
    gt
          | Bool
    otherwise
          = Q Exp -> [Q Match] -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
    caseE (OrdFun -> TyVarMap1 -> Name -> Type -> Q Exp
    makeOrdFunForType (OrdClass -> OrdFun
    ordClassToCompare (OrdClass -> OrdFun) -> OrdClass -> OrdFun
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> OrdClass
    ordFunToClass OrdFun
    oFun)
                       TyVarMap1
    tvMap Name
    conName Type
    ty Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    aExpr Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    bExpr)
                  [ Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    ltDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    lt) []
                  , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    eqDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    eq) []
                  , Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    gtDataName []) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    gt) []
                  ]
          where
            aExpr, bExpr :: Q Exp
            aExpr :: Q Exp
    aExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    a
            bExpr :: Q Exp
    bExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    b

    makeOrdFunForType :: OrdFun
                      -> TyVarMap1
                      -> Name
                      -> Type
                      -> Q Exp
    #if defined(NEW_FUNCTOR_CLASSES)
    makeOrdFunForType :: OrdFun -> TyVarMap1 -> Name -> Type -> Q Exp
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    _ (VarT Name
    tyName) =
        Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ case Name -> TyVarMap1 -> Maybe (OneOrTwoNames One)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    tyName TyVarMap1
    tvMap of
          Just (OneName Name
    ord) -> Name
    ord
          Maybe (OneOrTwoNames One)
    Nothing            -> OrdFun -> Int -> Name
    ordFunName OrdFun
    oFun Int
    0
    #else
    makeOrdFunForType oFun _ _ VarT{} = varE $ ordFunName oFun 0
    #endif
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName (SigT Type
    ty Type
    _)      = OrdFun -> TyVarMap1 -> Name -> Type -> Q Exp
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName Type
    ty
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName (ForallT [TyVarBndr Specificity]
    _ Cxt
    _ Type
    ty) = OrdFun -> TyVarMap1 -> Name -> Type -> Q Exp
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName Type
    ty
    #if defined(NEW_FUNCTOR_CLASSES)
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName Type
    ty = do
        let oClass :: OrdClass
            oClass :: OrdClass
    oClass = OrdFun -> OrdClass
    ordFunToClass OrdFun
    oFun

            tyCon :: Type
            tyArgs :: [Type]
            (Type
    tyCon, Cxt
    tyArgs) = Type -> (Type, Cxt)
    unapplyTy Type
    ty

            numLastArgs :: Int
            numLastArgs :: Int
    numLastArgs = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (OrdClass -> Int
    forall a. ClassRep a => a -> Int
    arity OrdClass
    oClass) (Cxt -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    tyArgs)

            lhsArgs, rhsArgs :: [Type]
            (Cxt
    lhsArgs, Cxt
    rhsArgs) = Int -> Cxt -> (Cxt, Cxt)
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Cxt -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length Cxt
    tyArgs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    numLastArgs) Cxt
    tyArgs

            tyVarNames :: [Name]
            tyVarNames :: [Name]
    tyVarNames = TyVarMap1 -> [Name]
    forall k a. Map k a -> [k]
    Map.keys TyVarMap1
    tvMap

        Bool
    itf <- [Name] -> Type -> Cxt -> Q Bool
    isInTypeFamilyApp [Name]
    tyVarNames Type
    tyCon Cxt
    tyArgs
        if (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    lhsArgs
              Bool -> Bool -> Bool
    || Bool
    itf Bool -> Bool -> Bool
    && (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    tyArgs
           then OrdClass -> Name -> Q Exp
    forall a b. ClassRep a => a -> Name -> Q b
    outOfPlaceTyVarError OrdClass
    oClass Name
    conName
           else if (Type -> Bool) -> Cxt -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Type -> [Name] -> Bool
    `mentionsName` [Name]
    tyVarNames) Cxt
    rhsArgs
                   then [Q Exp] -> Q Exp
    forall (m :: * -> *). Quote m => [m Exp] -> m Exp
    appsE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> Q Exp) -> (Int -> Name) -> Int -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OrdFun -> Int -> Name
    ordFunName OrdFun
    oFun (Int -> Q Exp) -> Int -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => Int -> a
    toEnum Int
    numLastArgs]
                                [Q Exp] -> [Q Exp] -> [Q Exp]
    forall a. [a] -> [a] -> [a]
    ++ (Type -> Q Exp) -> Cxt -> [Q Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrdFun -> TyVarMap1 -> Name -> Type -> Q Exp
    makeOrdFunForType OrdFun
    oFun TyVarMap1
    tvMap Name
    conName) Cxt
    rhsArgs
                   else Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> Q Exp) -> Name -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ OrdFun -> Int -> Name
    ordFunName OrdFun
    oFun Int
    0
    #else
    makeOrdFunForType oFun tvMap conName ty = do
      let varNames = Map.keys tvMap
          oClass   = ordFunToClass oFun

      a' <- newName "a'"
      b' <- newName "b'"
      case varNames of
        [] -> varE $ ordFunName oFun 0
        varName:_ ->
          if mentionsName ty varNames
             then lamE (map varP [a',b']) $ varE (ordFunName oFun 1)
                    `appE` (makeFmapApplyNeg oClass conName ty varName `appE` varE a')
                    `appE` (makeFmapApplyNeg oClass conName ty varName `appE` varE b')
             else varE $ ordFunName oFun 0
    #endif

    -------------------------------------------------------------------------------
    -- Class-specific constants
    -------------------------------------------------------------------------------

    -- | A representation of which @Ord@ variant is being derived.
    data OrdClass = Ord
                  | Ord1
    #if defined(NEW_FUNCTOR_CLASSES)
                  | Ord2
    #endif
      deriving (OrdClass
    OrdClass -> OrdClass -> Bounded OrdClass
    forall a. a -> a -> Bounded a
    $cminBound :: OrdClass
    minBound :: OrdClass
    $cmaxBound :: OrdClass
    maxBound :: OrdClass
    Bounded, Int -> OrdClass
    OrdClass -> Int
    OrdClass -> [OrdClass]
    OrdClass -> OrdClass
    OrdClass -> OrdClass -> [OrdClass]
    OrdClass -> OrdClass -> OrdClass -> [OrdClass]
    (OrdClass -> OrdClass)
    -> (OrdClass -> OrdClass)
    -> (Int -> OrdClass)
    -> (OrdClass -> Int)
    -> (OrdClass -> [OrdClass])
    -> (OrdClass -> OrdClass -> [OrdClass])
    -> (OrdClass -> OrdClass -> [OrdClass])
    -> (OrdClass -> OrdClass -> OrdClass -> [OrdClass])
    -> Enum OrdClass
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: OrdClass -> OrdClass
    succ :: OrdClass -> OrdClass
    $cpred :: OrdClass -> OrdClass
    pred :: OrdClass -> OrdClass
    $ctoEnum :: Int -> OrdClass
    toEnum :: Int -> OrdClass
    $cfromEnum :: OrdClass -> Int
    fromEnum :: OrdClass -> Int
    $cenumFrom :: OrdClass -> [OrdClass]
    enumFrom :: OrdClass -> [OrdClass]
    $cenumFromThen :: OrdClass -> OrdClass -> [OrdClass]
    enumFromThen :: OrdClass -> OrdClass -> [OrdClass]
    $cenumFromTo :: OrdClass -> OrdClass -> [OrdClass]
    enumFromTo :: OrdClass -> OrdClass -> [OrdClass]
    $cenumFromThenTo :: OrdClass -> OrdClass -> OrdClass -> [OrdClass]
    enumFromThenTo :: OrdClass -> OrdClass -> OrdClass -> [OrdClass]
    Enum)

    instance ClassRep OrdClass where
        arity :: OrdClass -> Int
    arity = OrdClass -> Int
    forall a. Enum a => a -> Int
    fromEnum

        allowExQuant :: OrdClass -> Bool
    allowExQuant OrdClass
    _ = Bool
    True

        fullClassName :: OrdClass -> Name
    fullClassName OrdClass
    Ord  = Name
    ordTypeName
        fullClassName OrdClass
    Ord1 = Name
    ord1TypeName
    #if defined(NEW_FUNCTOR_CLASSES)
        fullClassName OrdClass
    Ord2 = Name
    ord2TypeName
    #endif

        classConstraint :: OrdClass -> Int -> Maybe Name
    classConstraint OrdClass
    oClass Int
    i
          | Int
    oMin Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    i Bool -> Bool -> Bool
    && Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    oMax = Name -> Maybe Name
    forall a. a -> Maybe a
    Just (Name -> Maybe Name) -> Name -> Maybe Name
    forall a b. (a -> b) -> a -> b
    $ OrdClass -> Name
    forall a. ClassRep a => a -> Name
    fullClassName (Int -> OrdClass
    forall a. Enum a => Int -> a
    toEnum Int
    i :: OrdClass)
          | Bool
    otherwise              = Maybe Name
    forall a. Maybe a
    Nothing
          where
            oMin, oMax :: Int
            oMin :: Int
    oMin = OrdClass -> Int
    forall a. Enum a => a -> Int
    fromEnum (OrdClass
    forall a. Bounded a => a
    minBound :: OrdClass)
            oMax :: Int
    oMax = OrdClass -> Int
    forall a. Enum a => a -> Int
    fromEnum OrdClass
    oClass

    compareConstName :: OrdFun -> Name
    compareConstName :: OrdFun -> Name
    compareConstName OrdFun
    OrdCompare       = Name
    compareConstValName
    compareConstName OrdFun
    OrdLT            = Name
    ltConstValName
    compareConstName OrdFun
    OrdLE            = Name
    ltConstValName
    compareConstName OrdFun
    OrdGT            = Name
    ltConstValName
    compareConstName OrdFun
    OrdGE            = Name
    ltConstValName
    #if defined(NEW_FUNCTOR_CLASSES)
    compareConstName OrdFun
    Ord1LiftCompare  = Name
    liftCompareConstValName
    compareConstName OrdFun
    Ord2LiftCompare2 = Name
    liftCompare2ConstValName
    #else
    compareConstName Ord1Compare1     = compare1ConstValName
    #endif

    ordClassToCompare :: OrdClass -> OrdFun
    ordClassToCompare :: OrdClass -> OrdFun
    ordClassToCompare OrdClass
    Ord  = OrdFun
    OrdCompare
    #if defined(NEW_FUNCTOR_CLASSES)
    ordClassToCompare OrdClass
    Ord1 = OrdFun
    Ord1LiftCompare
    ordClassToCompare OrdClass
    Ord2 = OrdFun
    Ord2LiftCompare2
    #else
    ordClassToCompare Ord1 = Ord1Compare1
    #endif

    data OrdFun = OrdCompare | OrdLT | OrdLE | OrdGE | OrdGT
    #if defined(NEW_FUNCTOR_CLASSES)
                | Ord1LiftCompare | Ord2LiftCompare2
    #else
                | Ord1Compare1
    #endif
      deriving OrdFun -> OrdFun -> Bool
    (OrdFun -> OrdFun -> Bool)
    -> (OrdFun -> OrdFun -> Bool) -> Eq OrdFun
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: OrdFun -> OrdFun -> Bool
    == :: OrdFun -> OrdFun -> Bool
    $c/= :: OrdFun -> OrdFun -> Bool
    /= :: OrdFun -> OrdFun -> Bool
    Eq

    ordFunName :: OrdFun -> Int -> Name
    ordFunName :: OrdFun -> Int -> Name
    ordFunName OrdFun
    OrdCompare       Int
    0 = Name
    compareValName
    ordFunName OrdFun
    OrdLT            Int
    0 = Name
    ltValName
    ordFunName OrdFun
    OrdLE            Int
    0 = Name
    leValName
    ordFunName OrdFun
    OrdGE            Int
    0 = Name
    geValName
    ordFunName OrdFun
    OrdGT            Int
    0 = Name
    gtValName
    #if defined(NEW_FUNCTOR_CLASSES)
    ordFunName OrdFun
    Ord1LiftCompare  Int
    0 = OrdFun -> Int -> Name
    ordFunName OrdFun
    OrdCompare Int
    0
    ordFunName OrdFun
    Ord1LiftCompare  Int
    1 = Name
    liftCompareValName
    ordFunName OrdFun
    Ord2LiftCompare2 Int
    0 = OrdFun -> Int -> Name
    ordFunName OrdFun
    OrdCompare Int
    0
    ordFunName OrdFun
    Ord2LiftCompare2 Int
    1 = OrdFun -> Int -> Name
    ordFunName OrdFun
    Ord1LiftCompare Int
    1
    ordFunName OrdFun
    Ord2LiftCompare2 Int
    2 = Name
    liftCompare2ValName
    #else
    ordFunName Ord1Compare1     0 = ordFunName OrdCompare 0
    ordFunName Ord1Compare1     1 = compare1ValName
    #endif
    ordFunName OrdFun
    _                Int
    _ = [Char] -> Name
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Data.Ord.Deriving.Internal.ordFunName"

    ordFunToClass :: OrdFun -> OrdClass
    ordFunToClass :: OrdFun -> OrdClass
    ordFunToClass OrdFun
    OrdCompare       = OrdClass
    Ord
    ordFunToClass OrdFun
    OrdLT            = OrdClass
    Ord
    ordFunToClass OrdFun
    OrdLE            = OrdClass
    Ord
    ordFunToClass OrdFun
    OrdGE            = OrdClass
    Ord
    ordFunToClass OrdFun
    OrdGT            = OrdClass
    Ord
    #if defined(NEW_FUNCTOR_CLASSES)
    ordFunToClass OrdFun
    Ord1LiftCompare  = OrdClass
    Ord1
    ordFunToClass OrdFun
    Ord2LiftCompare2 = OrdClass
    Ord2
    #else
    ordFunToClass Ord1Compare1     = Ord1
    #endif

    eqResult :: OrdFun -> Q Exp
    eqResult :: OrdFun -> Q Exp
    eqResult OrdFun
    OrdCompare       = Q Exp
    eqTagExpr
    eqResult OrdFun
    OrdLT            = Q Exp
    falseExpr
    eqResult OrdFun
    OrdLE            = Q Exp
    trueExpr
    eqResult OrdFun
    OrdGE            = Q Exp
    trueExpr
    eqResult OrdFun
    OrdGT            = Q Exp
    falseExpr
    #if defined(NEW_FUNCTOR_CLASSES)
    eqResult OrdFun
    Ord1LiftCompare  = Q Exp
    eqTagExpr
    eqResult OrdFun
    Ord2LiftCompare2 = Q Exp
    eqTagExpr
    #else
    eqResult Ord1Compare1     = eqTagExpr
    #endif

    gtResult :: OrdFun -> Q Exp
    gtResult :: OrdFun -> Q Exp
    gtResult OrdFun
    OrdCompare       = Q Exp
    gtTagExpr
    gtResult OrdFun
    OrdLT            = Q Exp
    falseExpr
    gtResult OrdFun
    OrdLE            = Q Exp
    falseExpr
    gtResult OrdFun
    OrdGE            = Q Exp
    trueExpr
    gtResult OrdFun
    OrdGT            = Q Exp
    trueExpr
    #if defined(NEW_FUNCTOR_CLASSES)
    gtResult OrdFun
    Ord1LiftCompare  = Q Exp
    gtTagExpr
    gtResult OrdFun
    Ord2LiftCompare2 = Q Exp
    gtTagExpr
    #else
    gtResult Ord1Compare1     = gtTagExpr
    #endif

    ltResult :: OrdFun -> Q Exp
    ltResult :: OrdFun -> Q Exp
    ltResult OrdFun
    OrdCompare       = Q Exp
    ltTagExpr
    ltResult OrdFun
    OrdLT            = Q Exp
    trueExpr
    ltResult OrdFun
    OrdLE            = Q Exp
    trueExpr
    ltResult OrdFun
    OrdGE            = Q Exp
    falseExpr
    ltResult OrdFun
    OrdGT            = Q Exp
    falseExpr
    #if defined(NEW_FUNCTOR_CLASSES)
    ltResult OrdFun
    Ord1LiftCompare  = Q Exp
    ltTagExpr
    ltResult OrdFun
    Ord2LiftCompare2 = Q Exp
    ltTagExpr
    #else
    ltResult Ord1Compare1     = ltTagExpr
    #endif

    -------------------------------------------------------------------------------
    -- Assorted utilities
    -------------------------------------------------------------------------------

    ltTagExpr, eqTagExpr, gtTagExpr, falseExpr, trueExpr :: Q Exp
    ltTagExpr :: Q Exp
    ltTagExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    ltDataName
    eqTagExpr :: Q Exp
    eqTagExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    eqDataName
    gtTagExpr :: Q Exp
    gtTagExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    gtDataName
    falseExpr :: Q Exp
    falseExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    falseDataName
    trueExpr :: Q Exp
    trueExpr  = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE Name
    trueDataName

    -- Besides compare, that is
    otherFuns :: OrdClass -> [ConstructorInfo] -> [OrdFun]
    otherFuns :: OrdClass -> [ConstructorInfo] -> [OrdFun]
    otherFuns OrdClass
    _ [] = [] -- We only need compare for empty data types.
    otherFuns OrdClass
    oClass [ConstructorInfo]
    cons = case OrdClass
    oClass of
        OrdClass
    Ord1 -> []
    #if defined(NEW_FUNCTOR_CLASSES)
        OrdClass
    Ord2 -> []
    #endif
        OrdClass
    Ord | (Int
    lastTag Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    firstTag) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    2 Bool -> Bool -> Bool
    || [ConstructorInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConstructorInfo]
    nonNullaryCons
           -> [OrdFun
    OrdLT, OrdFun
    OrdLE, OrdFun
    OrdGE, OrdFun
    OrdGT]
            | Bool
    otherwise
           -> []
      where
        firstTag, lastTag :: Int
        firstTag :: Int
    firstTag = Int
    0
        lastTag :: Int
    lastTag  = [ConstructorInfo] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ConstructorInfo]
    cons Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

        nonNullaryCons :: [ConstructorInfo]
        nonNullaryCons :: [ConstructorInfo]
    nonNullaryCons = (ConstructorInfo -> Bool) -> [ConstructorInfo] -> [ConstructorInfo]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut ConstructorInfo -> Bool
    isNullaryCon [ConstructorInfo]
    cons

    unliftedOrdFun :: Name -> OrdFun -> Name -> Name -> Q Exp
    unliftedOrdFun :: Name -> OrdFun -> Name -> Name -> Q Exp
    unliftedOrdFun Name
    tyName OrdFun
    oFun Name
    a Name
    b = case OrdFun
    oFun of
        OrdFun
    OrdCompare       -> Q Exp
    unliftedCompareExpr
        OrdFun
    OrdLT            -> Name -> Q Exp
    wrap Name
    ltFun
        OrdFun
    OrdLE            -> Name -> Q Exp
    wrap Name
    leFun
        OrdFun
    OrdGE            -> Name -> Q Exp
    wrap Name
    geFun
        OrdFun
    OrdGT            -> Name -> Q Exp
    wrap Name
    gtFun
    #if defined(NEW_FUNCTOR_CLASSES)
        OrdFun
    Ord1LiftCompare  -> Q Exp
    unliftedCompareExpr
        OrdFun
    Ord2LiftCompare2 -> Q Exp
    unliftedCompareExpr
    #else
        Ord1Compare1     -> unliftedCompareExpr
    #endif
      where
        unliftedCompareExpr :: Q Exp
        unliftedCompareExpr :: Q Exp
    unliftedCompareExpr = Name -> Name -> Q Exp -> Q Exp -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    unliftedCompare Name
    ltFun Name
    eqFun Q Exp
    aExpr Q Exp
    bExpr
                                              Q Exp
    ltTagExpr Q Exp
    eqTagExpr Q Exp
    gtTagExpr

        ltFun, leFun, eqFun, geFun, gtFun :: Name
        (Name
    ltFun, Name
    leFun, Name
    eqFun, Name
    geFun, Name
    gtFun) = Name -> (Name, Name, Name, Name, Name)
    primOrdFuns Name
    tyName

        wrap :: Name -> Q Exp
        wrap :: Name -> Q Exp
    wrap Name
    primFun = Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr Q Exp
    aExpr Name
    primFun Q Exp
    bExpr

        aExpr, bExpr :: Q Exp
        aExpr :: Q Exp
    aExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    a
        bExpr :: Q Exp
    bExpr = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    b

    unliftedCompare :: Name -> Name
                    -> Q Exp -> Q Exp          -- What to compare
                    -> Q Exp -> Q Exp -> Q Exp -- Three results
                    -> Q Exp
    unliftedCompare :: Name -> Name -> Q Exp -> Q Exp -> Q Exp -> Q Exp -> Q Exp -> Q Exp
    unliftedCompare Name
    ltFun Name
    eqFun Q Exp
    aExpr Q Exp
    bExpr Q Exp
    lt Q Exp
    eq Q Exp
    gt =
        Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    condE (Q Exp -> Q Exp
    ascribeBool (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr Q Exp
    aExpr Name
    ltFun Q Exp
    bExpr) Q Exp
    lt (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $
            Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    condE (Q Exp -> Q Exp
    ascribeBool (Q Exp -> Q Exp) -> Q Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Q Exp -> Name -> Q Exp -> Q Exp
    primOpAppExpr Q Exp
    aExpr Name
    eqFun Q Exp
    bExpr) Q Exp
    eq Q Exp
    gt
      where
        ascribeBool :: Q Exp -> Q Exp
        ascribeBool :: Q Exp -> Q Exp
    ascribeBool Q Exp
    e = Q Exp -> Q Type -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Type -> m Exp
    sigE Q Exp
    e (Q Type -> Q Exp) -> Q Type -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    boolTypeName

    primOrdFuns :: Name -> (Name, Name, Name, Name, Name)
    primOrdFuns :: Name -> (Name, Name, Name, Name, Name)
    primOrdFuns Name
    tyName =
      case Name
    -> Map Name (Name, Name, Name, Name, Name)
    -> Maybe (Name, Name, Name, Name, Name)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    tyName Map Name (Name, Name, Name, Name, Name)
    primOrdFunTbl of
        Just (Name, Name, Name, Name, Name)
    names -> (Name, Name, Name, Name, Name)
    names
        Maybe (Name, Name, Name, Name, Name)
    Nothing    -> [Char] -> (Name, Name, Name, Name, Name)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (Name, Name, Name, Name, Name))
    -> [Char] -> (Name, Name, Name, Name, Name)
    forall a b. (a -> b) -> a -> b
    $ Name -> [Char]
    nameBase Name
    tyName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " is not supported."

    isSupportedUnliftedType :: Type -> Bool
    isSupportedUnliftedType :: Type -> Bool
    isSupportedUnliftedType (ConT Name
    tyName) = Name -> Map Name (Name, Name, Name, Name, Name) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member Name
    tyName Map Name (Name, Name, Name, Name, Name)
    primOrdFunTbl
    isSupportedUnliftedType Type
    _             = Bool
    False

    isSingleton :: [a] -> Bool
    isSingleton :: forall a. [a] -> Bool
    isSingleton [a
    _] = Bool
    True
    isSingleton [a]
    _   = Bool
    False

    -- | Like 'filter', only it reverses the sense of the test
    filterOut :: (a -> Bool) -> [a] -> [a]
    filterOut :: forall a. (a -> Bool) -> [a] -> [a]
    filterOut a -> Bool
    _ [] = []
    filterOut a -> Bool
    p (a
    x:[a]
    xs) | a -> Bool
    p a
    x       = (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut a -> Bool
    p [a]
    xs
                       | Bool
    otherwise = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut a -> Bool
    p [a]
    xs