{-# LANGUAGE CPP #-}

module GhcApi.Compare
  ( cmpType
  , cmpTypes
  , cmpTyCon
  , thenCmp
  ) where

import GhcApi

import GHC.Utils.Misc (thenCmp)

-- TODO: all this is deeply dodgy!  These comparison functions are
-- non-deterministic, so we may end up getting different results on different
-- runs.  Really we should replace them with deterministic versions.

cmpTyCon :: TyCon -> TyCon -> Ordering
cmpTyCon :: TyCon -> TyCon -> Ordering
cmpTyCon = TyCon -> TyCon -> Ordering
nonDetCmpTc

cmpType :: Type -> Type -> Ordering
#if __GLASGOW_HASKELL__ > 900
cmpType :: Type -> Type -> Ordering
cmpType (LitTy TyLit
x) (LitTy TyLit
y) = TyLit -> TyLit -> Ordering
cmpTyLit TyLit
x TyLit
y
cmpType Type
t1 Type
t2 = Type -> Type -> Ordering
nonDetCmpType Type
t1 Type
t2
#else
cmpType = nonDetCmpType
#endif

cmpTypes :: [Type] -> [Type] -> Ordering
cmpTypes :: [Type] -> [Type] -> Ordering
cmpTypes [] [] = Ordering
EQ
cmpTypes (Type
t1:[Type]
ts1) (Type
t2:[Type]
ts2) = Type -> Type -> Ordering
cmpType Type
t1 Type
t2 Ordering -> Ordering -> Ordering
`thenCmp` [Type] -> [Type] -> Ordering
cmpTypes [Type]
ts1 [Type]
ts2
cmpTypes [] [Type]
_ = Ordering
LT
cmpTypes [Type]
_ [] = Ordering
GT