{-# LANGUAGE CPP #-}
module GhcDump.Convert where

import Data.Bifunctor
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE

import Literal (Literal(..))
#if MIN_VERSION_ghc(8,6,0)
import qualified Literal
#endif
import Var (Var)
import qualified Var
import Id (isFCallId)
import Module (ModuleName, moduleNameFS, moduleName)
import Unique (Unique, getUnique, unpkUnique)
import Name (getOccName, occNameFS, OccName, getName, nameModule_maybe)
import qualified IdInfo
import qualified BasicTypes as OccInfo (OccInfo(..), isStrongLoopBreaker)
#if MIN_VERSION_ghc(8,0,0)
import qualified CoreStats
#else
import qualified CoreUtils as CoreStats
#endif
import qualified CoreSyn
import CoreSyn (Expr(..), CoreExpr, Bind(..), CoreAlt, CoreBind, AltCon(..))
import HscTypes (ModGuts(..))
import FastString (FastString)
import qualified FastString
#if MIN_VERSION_ghc(8,2,0)
import TyCoRep as Type (Type(..))
#elif MIN_VERSION_ghc(8,0,0)
import TyCoRep as Type (Type(..), TyBinder(..))
#else
import TypeRep as Type (Type(..))
#endif
#if !(MIN_VERSION_ghc(8,2,0))
import Type (splitFunTy_maybe)
#endif
import TyCon (TyCon, tyConUnique)

import Outputable (ppr, showSDoc, SDoc)
import DynFlags (unsafeGlobalDynFlags)

import GhcDump.Ast as Ast

cvtSDoc :: SDoc -> T.Text
cvtSDoc :: SDoc -> Text
cvtSDoc = String -> Text
T.pack (String -> Text) -> (SDoc -> String) -> SDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
showSDoc DynFlags
unsafeGlobalDynFlags

fastStringToText :: FastString -> T.Text
fastStringToText :: FastString -> Text
fastStringToText = ByteString -> Text
TE.decodeUtf8
#if MIN_VERSION_ghc(8,10,0)
  (ByteString -> Text)
-> (FastString -> ByteString) -> FastString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> ByteString
FastString.bytesFS
#else
  . FastString.fastStringToByteString
#endif

occNameToText :: OccName -> T.Text
occNameToText :: OccName -> Text
occNameToText = FastString -> Text
fastStringToText (FastString -> Text) -> (OccName -> FastString) -> OccName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS

cvtUnique :: Unique.Unique -> Ast.Unique
cvtUnique :: Unique -> Unique
cvtUnique Unique
u =
    let (Char
a,Int
b) = Unique -> (Char, Int)
unpkUnique Unique
u
    in Char -> Int -> Unique
Ast.Unique Char
a Int
b

cvtVar :: Var -> BinderId
cvtVar :: Var -> BinderId
cvtVar = Unique -> BinderId
BinderId (Unique -> BinderId) -> (Var -> Unique) -> Var -> BinderId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique -> Unique
cvtUnique (Unique -> Unique) -> (Var -> Unique) -> Var -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Unique
Var.varUnique

cvtBinder :: Var -> SBinder
cvtBinder :: Var -> SBinder
cvtBinder Var
v
  | Var -> Bool
Var.isId Var
v =
    Binder' SBinder BinderId -> SBinder
SBndr (Binder' SBinder BinderId -> SBinder)
-> Binder' SBinder BinderId -> SBinder
forall a b. (a -> b) -> a -> b
$ Binder :: forall bndr var.
Text
-> BinderId
-> IdInfo bndr var
-> IdDetails
-> Type' bndr var
-> Binder' bndr var
Binder { binderName :: Text
binderName   = OccName -> Text
occNameToText (OccName -> Text) -> OccName -> Text
forall a b. (a -> b) -> a -> b
$ Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
v
                   , binderId :: BinderId
binderId     = Var -> BinderId
cvtVar Var
v
                   , binderIdInfo :: IdInfo SBinder BinderId
binderIdInfo = IdInfo -> IdInfo SBinder BinderId
cvtIdInfo (IdInfo -> IdInfo SBinder BinderId)
-> IdInfo -> IdInfo SBinder BinderId
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Var -> IdInfo
Var -> IdInfo
Var.idInfo Var
v
                   , binderIdDetails :: IdDetails
binderIdDetails = IdDetails -> IdDetails
cvtIdDetails (IdDetails -> IdDetails) -> IdDetails -> IdDetails
forall a b. (a -> b) -> a -> b
$ Var -> IdDetails
Var.idDetails Var
v
                   , binderType :: Type' SBinder BinderId
binderType   = Type -> Type' SBinder BinderId
cvtType (Type -> Type' SBinder BinderId) -> Type -> Type' SBinder BinderId
forall a b. (a -> b) -> a -> b
$ Var -> Type
Var.varType Var
v
                   }
  | Bool
otherwise =
    Binder' SBinder BinderId -> SBinder
SBndr (Binder' SBinder BinderId -> SBinder)
-> Binder' SBinder BinderId -> SBinder
forall a b. (a -> b) -> a -> b
$ TyBinder :: forall bndr var.
Text -> BinderId -> Type' bndr var -> Binder' bndr var
TyBinder { binderName :: Text
binderName   = OccName -> Text
occNameToText (OccName -> Text) -> OccName -> Text
forall a b. (a -> b) -> a -> b
$ Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
v
                     , binderId :: BinderId
binderId     = Var -> BinderId
cvtVar Var
v
                     , binderKind :: Type' SBinder BinderId
binderKind   = Type -> Type' SBinder BinderId
cvtType (Type -> Type' SBinder BinderId) -> Type -> Type' SBinder BinderId
forall a b. (a -> b) -> a -> b
$ Var -> Type
Var.varType Var
v
                     }

cvtIdInfo :: IdInfo.IdInfo -> Ast.IdInfo SBinder BinderId
cvtIdInfo :: IdInfo -> IdInfo SBinder BinderId
cvtIdInfo IdInfo
i =
    IdInfo :: forall bndr var.
Int
-> Bool
-> Unfolding bndr var
-> Text
-> OccInfo
-> Text
-> Text
-> Int
-> IdInfo bndr var
IdInfo { idiArity :: Int
idiArity         = IdInfo -> Int
IdInfo.arityInfo IdInfo
i
           , idiIsOneShot :: Bool
idiIsOneShot     = IdInfo -> OneShotInfo
IdInfo.oneShotInfo IdInfo
i OneShotInfo -> OneShotInfo -> Bool
forall a. Eq a => a -> a -> Bool
== OneShotInfo
IdInfo.OneShotLam
           , idiUnfolding :: Unfolding SBinder BinderId
idiUnfolding     = Unfolding -> Unfolding SBinder BinderId
cvtUnfolding (Unfolding -> Unfolding SBinder BinderId)
-> Unfolding -> Unfolding SBinder BinderId
forall a b. (a -> b) -> a -> b
$ IdInfo -> Unfolding
IdInfo.unfoldingInfo IdInfo
i
           , idiInlinePragma :: Text
idiInlinePragma  = SDoc -> Text
cvtSDoc (SDoc -> Text) -> SDoc -> Text
forall a b. (a -> b) -> a -> b
$ InlinePragma -> SDoc
forall a. Outputable a => a -> SDoc
ppr (InlinePragma -> SDoc) -> InlinePragma -> SDoc
forall a b. (a -> b) -> a -> b
$ IdInfo -> InlinePragma
IdInfo.inlinePragInfo IdInfo
i
           , idiOccInfo :: OccInfo
idiOccInfo       = case IdInfo -> OccInfo
IdInfo.occInfo IdInfo
i of
#if MIN_VERSION_ghc(8,2,0)
                                  OccInfo.ManyOccs{} -> OccInfo
OccManyOccs
#else
                                  OccInfo.NoOccInfo  -> OccManyOccs
#endif
                                  OccInfo
OccInfo.IAmDead    -> OccInfo
OccDead
                                  OccInfo.OneOcc{}   -> OccInfo
OccOneOcc
                                  oi :: OccInfo
oi@OccInfo.IAmALoopBreaker{} -> Bool -> OccInfo
OccLoopBreaker (OccInfo -> Bool
OccInfo.isStrongLoopBreaker OccInfo
oi)
           , idiStrictnessSig :: Text
idiStrictnessSig = SDoc -> Text
cvtSDoc (SDoc -> Text) -> SDoc -> Text
forall a b. (a -> b) -> a -> b
$ StrictSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr (StrictSig -> SDoc) -> StrictSig -> SDoc
forall a b. (a -> b) -> a -> b
$ IdInfo -> StrictSig
IdInfo.strictnessInfo IdInfo
i
           , idiDemandSig :: Text
idiDemandSig     = SDoc -> Text
cvtSDoc (SDoc -> Text) -> SDoc -> Text
forall a b. (a -> b) -> a -> b
$ Demand -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Demand -> SDoc) -> Demand -> SDoc
forall a b. (a -> b) -> a -> b
$ IdInfo -> Demand
IdInfo.demandInfo IdInfo
i
           , idiCallArity :: Int
idiCallArity     = IdInfo -> Int
IdInfo.callArityInfo IdInfo
i
           }

cvtUnfolding :: CoreSyn.Unfolding -> Ast.Unfolding SBinder BinderId
cvtUnfolding :: Unfolding -> Unfolding SBinder BinderId
cvtUnfolding Unfolding
CoreSyn.NoUnfolding = Unfolding SBinder BinderId
forall bndr var. Unfolding bndr var
Ast.NoUnfolding
#if MIN_VERSION_ghc(8,2,0)
cvtUnfolding Unfolding
CoreSyn.BootUnfolding = Unfolding SBinder BinderId
forall bndr var. Unfolding bndr var
Ast.BootUnfolding
#endif
cvtUnfolding (CoreSyn.OtherCon [AltCon]
cons) = [AltCon] -> Unfolding SBinder BinderId
forall bndr var. [AltCon] -> Unfolding bndr var
Ast.OtherCon ((AltCon -> AltCon) -> [AltCon] -> [AltCon]
forall a b. (a -> b) -> [a] -> [b]
map AltCon -> AltCon
cvtAltCon [AltCon]
cons)
cvtUnfolding (CoreSyn.DFunUnfolding{}) = Unfolding SBinder BinderId
forall bndr var. Unfolding bndr var
Ast.DFunUnfolding
cvtUnfolding u :: Unfolding
u@(CoreSyn.CoreUnfolding{}) =
    CoreUnfolding :: forall bndr var.
Expr' bndr var
-> Bool -> Bool -> Bool -> Text -> Unfolding bndr var
Ast.CoreUnfolding { unfTemplate :: Expr' SBinder BinderId
unfTemplate   = CoreExpr -> Expr' SBinder BinderId
cvtExpr (CoreExpr -> Expr' SBinder BinderId)
-> CoreExpr -> Expr' SBinder BinderId
forall a b. (a -> b) -> a -> b
$ Unfolding -> CoreExpr
CoreSyn.uf_tmpl Unfolding
u
                      , unfIsValue :: Bool
unfIsValue    = Unfolding -> Bool
CoreSyn.uf_is_value Unfolding
u
                      , unfIsConLike :: Bool
unfIsConLike  = Unfolding -> Bool
CoreSyn.uf_is_conlike Unfolding
u
                      , unfIsWorkFree :: Bool
unfIsWorkFree = Unfolding -> Bool
CoreSyn.uf_is_work_free Unfolding
u
                      , unfGuidance :: Text
unfGuidance   = SDoc -> Text
cvtSDoc (SDoc -> Text) -> SDoc -> Text
forall a b. (a -> b) -> a -> b
$ UnfoldingGuidance -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnfoldingGuidance -> SDoc) -> UnfoldingGuidance -> SDoc
forall a b. (a -> b) -> a -> b
$ Unfolding -> UnfoldingGuidance
CoreSyn.uf_guidance Unfolding
u
                      }

cvtIdDetails :: IdInfo.IdDetails -> Ast.IdDetails
cvtIdDetails :: IdDetails -> IdDetails
cvtIdDetails IdDetails
d =
    case IdDetails
d of
      IdDetails
IdInfo.VanillaId -> IdDetails
Ast.VanillaId
      IdInfo.RecSelId{} -> IdDetails
Ast.RecSelId
      IdInfo.DataConWorkId{} -> IdDetails
Ast.DataConWorkId
      IdInfo.DataConWrapId{} -> IdDetails
Ast.DataConWrapId
      IdInfo.ClassOpId{} -> IdDetails
Ast.ClassOpId
      IdInfo.PrimOpId{} -> IdDetails
Ast.PrimOpId
      IdInfo.FCallId{} -> String -> IdDetails
forall a. HasCallStack => String -> a
error String
"This shouldn't happen"
      IdInfo.TickBoxOpId{} -> IdDetails
Ast.TickBoxOpId
      IdInfo.DFunId{} -> IdDetails
Ast.DFunId
#if MIN_VERSION_ghc(8,0,0)
      IdInfo.CoVarId{} -> IdDetails
Ast.CoVarId
#endif
#if MIN_VERSION_ghc(8,2,0)
      IdInfo.JoinId Int
n -> Int -> IdDetails
Ast.JoinId Int
n
#endif

cvtCoreStats :: CoreStats.CoreStats -> Ast.CoreStats
cvtCoreStats :: CoreStats -> CoreStats
cvtCoreStats CoreStats
stats =
    CoreStats :: Int -> Int -> Int -> Int -> Int -> CoreStats
Ast.CoreStats
      { csTerms :: Int
csTerms     = CoreStats -> Int
CoreStats.cs_tm CoreStats
stats
      , csTypes :: Int
csTypes     = CoreStats -> Int
CoreStats.cs_ty CoreStats
stats
      , csCoercions :: Int
csCoercions = CoreStats -> Int
CoreStats.cs_co CoreStats
stats
#if MIN_VERSION_ghc(8,2,0)
      , csValBinds :: Int
csValBinds  = CoreStats -> Int
CoreStats.cs_vb CoreStats
stats
      , csJoinBinds :: Int
csJoinBinds = CoreStats -> Int
CoreStats.cs_jb CoreStats
stats
#else
      , csValBinds  = 0
      , csJoinBinds = 0
#endif
      }

exprStats :: CoreExpr -> CoreStats.CoreStats
#if MIN_VERSION_ghc(8,0,0)
exprStats :: CoreExpr -> CoreStats
exprStats = CoreExpr -> CoreStats
CoreStats.exprStats
#else
-- exprStats wasn't exported in 7.10
exprStats _ = CoreStats.CS 0 0 0
#endif

cvtTopBind :: CoreBind -> STopBinding
cvtTopBind :: CoreBind -> STopBinding
cvtTopBind (NonRec Var
b CoreExpr
e) =
    SBinder -> CoreStats -> Expr' SBinder BinderId -> STopBinding
forall bndr var.
bndr -> CoreStats -> Expr' bndr var -> TopBinding' bndr var
NonRecTopBinding (Var -> SBinder
cvtBinder Var
b) (CoreStats -> CoreStats
cvtCoreStats (CoreStats -> CoreStats) -> CoreStats -> CoreStats
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreStats
exprStats CoreExpr
e) (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)
cvtTopBind (Rec [(Var, CoreExpr)]
bs) =
    [(SBinder, CoreStats, Expr' SBinder BinderId)] -> STopBinding
forall bndr var.
[(bndr, CoreStats, Expr' bndr var)] -> TopBinding' bndr var
RecTopBinding ([(SBinder, CoreStats, Expr' SBinder BinderId)] -> STopBinding)
-> [(SBinder, CoreStats, Expr' SBinder BinderId)] -> STopBinding
forall a b. (a -> b) -> a -> b
$ ((Var, CoreExpr) -> (SBinder, CoreStats, Expr' SBinder BinderId))
-> [(Var, CoreExpr)]
-> [(SBinder, CoreStats, Expr' SBinder BinderId)]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> (SBinder, CoreStats, Expr' SBinder BinderId)
to [(Var, CoreExpr)]
bs
  where to :: (Var, CoreExpr) -> (SBinder, CoreStats, Expr' SBinder BinderId)
to (Var
b, CoreExpr
e) = (Var -> SBinder
cvtBinder Var
b, CoreStats -> CoreStats
cvtCoreStats (CoreStats -> CoreStats) -> CoreStats -> CoreStats
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreStats
exprStats CoreExpr
e, CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)

cvtExpr :: CoreExpr -> Ast.SExpr
cvtExpr :: CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
expr =
  case CoreExpr
expr of
    Var Var
x
        -- foreign calls are local but have no binding site.
        -- TODO: use hasNoBinding here.
      | Var -> Bool
isFCallId Var
x   -> ExternalName -> Expr' SBinder BinderId
forall bndr var. ExternalName -> Expr' bndr var
EVarGlobal ExternalName
ForeignCall
      | Just Module
m <- Name -> Maybe Module
nameModule_maybe (Name -> Maybe Module) -> Name -> Maybe Module
forall a b. (a -> b) -> a -> b
$ Var -> Name
forall a. NamedThing a => a -> Name
getName Var
x
                      -> ExternalName -> Expr' SBinder BinderId
forall bndr var. ExternalName -> Expr' bndr var
EVarGlobal (ExternalName -> Expr' SBinder BinderId)
-> ExternalName -> Expr' SBinder BinderId
forall a b. (a -> b) -> a -> b
$ ModuleName -> Text -> Unique -> ExternalName
ExternalName (ModuleName -> ModuleName
cvtModuleName (ModuleName -> ModuleName) -> ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
Module.moduleName Module
m)
                                                   (OccName -> Text
occNameToText (OccName -> Text) -> OccName -> Text
forall a b. (a -> b) -> a -> b
$ Var -> OccName
forall a. NamedThing a => a -> OccName
getOccName Var
x)
                                                   (Unique -> Unique
cvtUnique (Unique -> Unique) -> Unique -> Unique
forall a b. (a -> b) -> a -> b
$ Var -> Unique
forall a. Uniquable a => a -> Unique
getUnique Var
x)
      | Bool
otherwise     -> BinderId -> Expr' SBinder BinderId
forall bndr var. var -> Expr' bndr var
EVar (Var -> BinderId
cvtVar Var
x)
    Lit Literal
l             -> Lit -> Expr' SBinder BinderId
forall bndr var. Lit -> Expr' bndr var
ELit (Literal -> Lit
cvtLit Literal
l)
    App CoreExpr
x CoreExpr
y           -> Expr' SBinder BinderId
-> Expr' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var. Expr' bndr var -> Expr' bndr var -> Expr' bndr var
EApp (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
x) (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
y)
    Lam Var
x CoreExpr
e
      | Var -> Bool
Var.isTyVar Var
x -> SBinder -> Expr' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var. bndr -> Expr' bndr var -> Expr' bndr var
ETyLam (Var -> SBinder
cvtBinder Var
x) (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)
      | Bool
otherwise     -> SBinder -> Expr' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var. bndr -> Expr' bndr var -> Expr' bndr var
ELam (Var -> SBinder
cvtBinder Var
x) (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)
    Let (NonRec Var
b CoreExpr
e) CoreExpr
body -> [(SBinder, Expr' SBinder BinderId)]
-> Expr' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var.
[(bndr, Expr' bndr var)] -> Expr' bndr var -> Expr' bndr var
ELet [(Var -> SBinder
cvtBinder Var
b, CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)] (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
body)
    Let (Rec [(Var, CoreExpr)]
bs) CoreExpr
body -> [(SBinder, Expr' SBinder BinderId)]
-> Expr' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var.
[(bndr, Expr' bndr var)] -> Expr' bndr var -> Expr' bndr var
ELet (((Var, CoreExpr) -> (SBinder, Expr' SBinder BinderId))
-> [(Var, CoreExpr)] -> [(SBinder, Expr' SBinder BinderId)]
forall a b. (a -> b) -> [a] -> [b]
map ((Var -> SBinder)
-> (CoreExpr -> Expr' SBinder BinderId)
-> (Var, CoreExpr)
-> (SBinder, Expr' SBinder BinderId)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Var -> SBinder
cvtBinder CoreExpr -> Expr' SBinder BinderId
cvtExpr) [(Var, CoreExpr)]
bs) (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
body)
    Case CoreExpr
e Var
x Type
_ [Alt Var]
as     -> Expr' SBinder BinderId
-> SBinder -> [Alt' SBinder BinderId] -> Expr' SBinder BinderId
forall bndr var.
Expr' bndr var -> bndr -> [Alt' bndr var] -> Expr' bndr var
ECase (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e) (Var -> SBinder
cvtBinder Var
x) ((Alt Var -> Alt' SBinder BinderId)
-> [Alt Var] -> [Alt' SBinder BinderId]
forall a b. (a -> b) -> [a] -> [b]
map Alt Var -> Alt' SBinder BinderId
cvtAlt [Alt Var]
as)
    Cast CoreExpr
x Coercion
_          -> CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
x
    Tick Tickish Var
_ CoreExpr
e          -> CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e
    Type Type
t            -> Type' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var. Type' bndr var -> Expr' bndr var
EType (Type' SBinder BinderId -> Expr' SBinder BinderId)
-> Type' SBinder BinderId -> Expr' SBinder BinderId
forall a b. (a -> b) -> a -> b
$ Type -> Type' SBinder BinderId
cvtType Type
t
    Coercion Coercion
_        -> Expr' SBinder BinderId
forall bndr var. Expr' bndr var
ECoercion

cvtAlt :: CoreAlt -> Ast.SAlt
cvtAlt :: Alt Var -> Alt' SBinder BinderId
cvtAlt (AltCon
con, [Var]
bs, CoreExpr
e) = AltCon
-> [SBinder] -> Expr' SBinder BinderId -> Alt' SBinder BinderId
forall bndr var.
AltCon -> [bndr] -> Expr' bndr var -> Alt' bndr var
Alt (AltCon -> AltCon
cvtAltCon AltCon
con) ((Var -> SBinder) -> [Var] -> [SBinder]
forall a b. (a -> b) -> [a] -> [b]
map Var -> SBinder
cvtBinder [Var]
bs) (CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)

cvtAltCon :: CoreSyn.AltCon -> Ast.AltCon
cvtAltCon :: AltCon -> AltCon
cvtAltCon (DataAlt DataCon
altcon) = Text -> AltCon
Ast.AltDataCon (Text -> AltCon) -> Text -> AltCon
forall a b. (a -> b) -> a -> b
$ OccName -> Text
occNameToText (OccName -> Text) -> OccName -> Text
forall a b. (a -> b) -> a -> b
$ DataCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName DataCon
altcon
cvtAltCon (LitAlt Literal
l)       = Lit -> AltCon
Ast.AltLit (Lit -> AltCon) -> Lit -> AltCon
forall a b. (a -> b) -> a -> b
$ Literal -> Lit
cvtLit Literal
l
cvtAltCon AltCon
DEFAULT          = AltCon
Ast.AltDefault

cvtLit :: Literal -> Ast.Lit
cvtLit :: Literal -> Lit
cvtLit Literal
l =
    case Literal
l of
#if MIN_VERSION_ghc(8,8,0)
      Literal.LitChar Char
x -> Char -> Lit
Ast.MachChar Char
x
      Literal.LitString ByteString
x -> ByteString -> Lit
Ast.MachStr ByteString
x
      Literal
Literal.LitNullAddr -> Lit
Ast.MachNullAddr
      Literal.LitFloat Rational
x -> Rational -> Lit
Ast.MachFloat Rational
x
      Literal.LitDouble Rational
x -> Rational -> Lit
Ast.MachDouble Rational
x
      Literal.LitLabel FastString
x Maybe Int
_ FunctionOrData
_ -> Text -> Lit
Ast.MachLabel (Text -> Lit) -> Text -> Lit
forall a b. (a -> b) -> a -> b
$ FastString -> Text
fastStringToText  FastString
x
      Literal
Literal.LitRubbish -> Lit
Ast.LitRubbish
#else
      Literal.MachChar x -> Ast.MachChar x
      Literal.MachStr x -> Ast.MachStr x
      Literal.MachNullAddr -> Ast.MachNullAddr
      Literal.MachFloat x -> Ast.MachFloat x
      Literal.MachDouble x -> Ast.MachDouble x
      Literal.MachLabel x _ _ -> Ast.MachLabel $ fastStringToText  x
#endif
#if MIN_VERSION_ghc(8,6,0)
      Literal.LitNumber LitNumType
numty Integer
n Type
_ ->
        case LitNumType
numty of
          LitNumType
Literal.LitNumInt -> Integer -> Lit
Ast.MachInt Integer
n
          LitNumType
Literal.LitNumInt64 -> Integer -> Lit
Ast.MachInt64 Integer
n
          LitNumType
Literal.LitNumWord -> Integer -> Lit
Ast.MachWord Integer
n
          LitNumType
Literal.LitNumWord64 -> Integer -> Lit
Ast.MachWord64 Integer
n
          LitNumType
Literal.LitNumInteger -> Integer -> Lit
Ast.LitInteger Integer
n
          LitNumType
Literal.LitNumNatural -> Integer -> Lit
Ast.LitNatural Integer
n
#else
      Literal.MachInt x -> Ast.MachInt x
      Literal.MachInt64 x -> Ast.MachInt64 x
      Literal.MachWord x -> Ast.MachWord x
      Literal.MachWord64 x -> Ast.MachWord64 x
      Literal.LitInteger x _ -> Ast.LitInteger x
#endif

cvtModule :: String -> ModGuts -> Ast.SModule
cvtModule :: String -> ModGuts -> SModule
cvtModule String
phase ModGuts
guts =
    ModuleName -> Text -> [STopBinding] -> SModule
forall bndr var.
ModuleName -> Text -> [TopBinding' bndr var] -> Module' bndr var
Ast.Module ModuleName
name (String -> Text
T.pack String
phase) ((CoreBind -> STopBinding) -> [CoreBind] -> [STopBinding]
forall a b. (a -> b) -> [a] -> [b]
map CoreBind -> STopBinding
cvtTopBind ([CoreBind] -> [STopBinding]) -> [CoreBind] -> [STopBinding]
forall a b. (a -> b) -> a -> b
$ ModGuts -> [CoreBind]
mg_binds ModGuts
guts)
  where name :: ModuleName
name = ModuleName -> ModuleName
cvtModuleName (ModuleName -> ModuleName) -> ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
Module.moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModGuts -> Module
mg_module ModGuts
guts

cvtModuleName :: Module.ModuleName -> Ast.ModuleName
cvtModuleName :: ModuleName -> ModuleName
cvtModuleName = Text -> ModuleName
Ast.ModuleName (Text -> ModuleName)
-> (ModuleName -> Text) -> ModuleName -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Text
fastStringToText (FastString -> Text)
-> (ModuleName -> FastString) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FastString
moduleNameFS

cvtType :: Type.Type -> Ast.SType
#if MIN_VERSION_ghc(8,10,0)
cvtType :: Type -> Type' SBinder BinderId
cvtType (Type.FunTy AnonArgFlag
_flag Type
a Type
b) = Type' SBinder BinderId
-> Type' SBinder BinderId -> Type' SBinder BinderId
forall bndr var. Type' bndr var -> Type' bndr var -> Type' bndr var
Ast.FunTy (Type -> Type' SBinder BinderId
cvtType Type
a) (Type -> Type' SBinder BinderId
cvtType Type
b)
#elif MIN_VERSION_ghc(8,2,0)
cvtType (Type.FunTy a b) = Ast.FunTy (cvtType a) (cvtType b)
#else
cvtType t
  | Just (a,b) <- splitFunTy_maybe t = Ast.FunTy (cvtType a) (cvtType b)
#endif
cvtType (Type.TyVarTy Var
v)       = BinderId -> Type' SBinder BinderId
forall bndr var. var -> Type' bndr var
Ast.VarTy (Var -> BinderId
cvtVar Var
v)
cvtType (Type.AppTy Type
a Type
b)       = Type' SBinder BinderId
-> Type' SBinder BinderId -> Type' SBinder BinderId
forall bndr var. Type' bndr var -> Type' bndr var -> Type' bndr var
Ast.AppTy (Type -> Type' SBinder BinderId
cvtType Type
a) (Type -> Type' SBinder BinderId
cvtType Type
b)
cvtType (Type.TyConApp TyCon
tc [Type]
tys) = TyCon -> [Type' SBinder BinderId] -> Type' SBinder BinderId
forall bndr var. TyCon -> [Type' bndr var] -> Type' bndr var
Ast.TyConApp (TyCon -> TyCon
cvtTyCon TyCon
tc) ((Type -> Type' SBinder BinderId)
-> [Type] -> [Type' SBinder BinderId]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type' SBinder BinderId
cvtType [Type]
tys)
#if MIN_VERSION_ghc(8,8,0)
cvtType (Type.ForAllTy (Var.Bndr Var
b ArgFlag
_) Type
t) = SBinder -> Type' SBinder BinderId -> Type' SBinder BinderId
forall bndr var. bndr -> Type' bndr var -> Type' bndr var
Ast.ForAllTy (Var -> SBinder
cvtBinder Var
b) (Type -> Type' SBinder BinderId
cvtType Type
t)
#elif MIN_VERSION_ghc(8,2,0)
cvtType (Type.ForAllTy (Var.TvBndr b _) t) = Ast.ForAllTy (cvtBinder b) (cvtType t)
#elif MIN_VERSION_ghc(8,0,0)
cvtType (Type.ForAllTy (Named b _) t) = Ast.ForAllTy (cvtBinder b) (cvtType t)
cvtType (Type.ForAllTy (Anon _) t)    = cvtType t
#else
cvtType (Type.ForAllTy b t)    = Ast.ForAllTy (cvtBinder b) (cvtType t)
#endif
cvtType (Type.LitTy TyLit
_)         = Type' SBinder BinderId
forall bndr var. Type' bndr var
Ast.LitTy
#if MIN_VERSION_ghc(8,0,0)
cvtType (Type.CastTy Type
t Coercion
_)      = Type -> Type' SBinder BinderId
cvtType Type
t
cvtType (Type.CoercionTy Coercion
_)    = Type' SBinder BinderId
forall bndr var. Type' bndr var
Ast.CoercionTy
#endif

cvtTyCon :: TyCon.TyCon -> Ast.TyCon
cvtTyCon :: TyCon -> TyCon
cvtTyCon TyCon
tc = Text -> Unique -> TyCon
TyCon (OccName -> Text
occNameToText (OccName -> Text) -> OccName -> Text
forall a b. (a -> b) -> a -> b
$ TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
tc) (Unique -> Unique
cvtUnique (Unique -> Unique) -> Unique -> Unique
forall a b. (a -> b) -> a -> b
$ TyCon -> Unique
tyConUnique TyCon
tc)