{-# LANGUAGE CPP #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NamedFieldPuns #-}

module GhcDump.Convert (cvtModule) where

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

#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Literal (Literal(..))
import qualified GHC.Types.Literal as Literal
import GHC.Types.Var (Var(..))
import qualified GHC.Types.Var as Var
import GHC.Types.Id (isFCallId)
import GHC.Unit.Module as Module (moduleName)
import GHC.Unit.Module.Name as Module (ModuleName, moduleNameFS)
import GHC.Types.Name (getOccName, occNameFS, OccName, getName, nameModule_maybe)
import qualified GHC.Types.Id.Info as IdInfo
import qualified GHC.Types.Basic as OccInfo (OccInfo(..), isStrongLoopBreaker)
import qualified GHC.Core.Stats as CoreStats
import qualified GHC.Core as CoreSyn
import GHC.Core (Expr(..), CoreExpr, Bind(..), CoreAlt, CoreBind, AltCon(..))
#if MIN_VERSION_ghc(9,2,0)
import GHC.Types.Tickish as CoreSyn (GenTickish(..))
import GHC.Unit.Module.ModGuts (ModGuts(..))
import GHC.Utils.Outputable (ppr, SDoc)
import GHC.Driver.Ppr (showSDoc)
#else
import GHC.Driver.Types (ModGuts(..))
import GHC.Utils.Outputable (ppr, showSDoc, SDoc)
#endif
import GHC.Data.FastString (FastString)
import qualified GHC.Data.FastString as FastString
import qualified GHC.Core.TyCo.Rep as Type
import GHC.Core.TyCon as TyCon (TyCon, tyConUnique)
import GHC.Types.Unique as Unique (Unique, getUnique, unpkUnique)
import GHC.Driver.Session (DynFlags)
import qualified GHC.Types.SrcLoc as SrcLoc

#else

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 SrcLoc
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(..), Tickish(..))
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 (DynFlags)
#endif

import GhcDump.Ast as Ast

import Prelude hiding (span)

data Env = Env { Env -> DynFlags
dflags :: DynFlags }

type HasEnv = (?env :: Env)

cvtSDoc :: HasEnv => 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 (Env -> DynFlags
dflags ?env::Env
Env
?env)

fastStringToText :: HasEnv => 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 :: HasEnv => OccName -> T.Text
occNameToText :: OccName -> Text
occNameToText = (?env::Env) => FastString -> Text
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 :: HasEnv => 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   = (?env::Env) => OccName -> Text
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 = (?env::Env) => IdInfo -> IdInfo SBinder BinderId
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 = (?env::Env) => IdDetails -> IdDetails
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   = (?env::Env) => Type -> Type' SBinder BinderId
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   = (?env::Env) => OccName -> Text
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   = (?env::Env) => Type -> Type' SBinder BinderId
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 :: HasEnv => 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     = (?env::Env) => Unfolding -> Unfolding SBinder BinderId
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  = (?env::Env) => SDoc -> Text
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 = (?env::Env) => SDoc -> Text
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     = (?env::Env) => SDoc -> Text
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 :: HasEnv => 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 (?env::Env) => AltCon -> AltCon
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   = (?env::Env) => CoreExpr -> Expr' SBinder BinderId
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   = (?env::Env) => SDoc -> Text
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 :: HasEnv => 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 :: HasEnv => 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 ((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
b) (CoreStats -> CoreStats
cvtCoreStats (CoreStats -> CoreStats) -> CoreStats -> CoreStats
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreStats
exprStats CoreExpr
e) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
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 (?env::Env) =>
(Var, CoreExpr) -> (SBinder, CoreStats, Expr' SBinder BinderId)
(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) = ((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
b, CoreStats -> CoreStats
cvtCoreStats (CoreStats -> CoreStats) -> CoreStats -> CoreStats
forall a b. (a -> b) -> a -> b
$ CoreExpr -> CoreStats
exprStats CoreExpr
e, (?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)

cvtExpr :: HasEnv => 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 ((?env::Env) => ModuleName -> ModuleName
ModuleName -> ModuleName
cvtModuleName (ModuleName -> ModuleName) -> ModuleName -> ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
Module.moduleName Module
m)
                                                   ((?env::Env) => OccName -> Text
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 ((?env::Env) => Literal -> Lit
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 ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
x) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
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 ((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
x) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
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 ((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
x) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
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 [((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
b, (?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)] ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
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 (?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder (?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr) [(Var, CoreExpr)]
bs) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
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 ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e) ((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
x) ((Alt Var -> Alt' SBinder BinderId)
-> [Alt Var] -> [Alt' SBinder BinderId]
forall a b. (a -> b) -> [a] -> [b]
map (?env::Env) => Alt Var -> Alt' SBinder BinderId
Alt Var -> Alt' SBinder BinderId
cvtAlt [Alt Var]
as)
    Cast CoreExpr
x Coercion
_          -> (?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
x
    Tick Tickish Var
tick CoreExpr
e
      | CoreSyn.SourceNote RealSrcSpan
sspan String
_name <- Tickish Var
tick
                      -> Tick -> Expr' SBinder BinderId -> Expr' SBinder BinderId
forall bndr var. Tick -> Expr' bndr var -> Expr' bndr var
ETick (SrcSpan -> Tick
Ast.SourceNote (SrcSpan -> Tick) -> SrcSpan -> Tick
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> SrcSpan
cvtRealSrcSpan RealSrcSpan
sspan) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)
      | Bool
otherwise     -> (?env::Env) => CoreExpr -> Expr' SBinder BinderId
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
$ (?env::Env) => Type -> Type' SBinder BinderId
Type -> Type' SBinder BinderId
cvtType Type
t
    Coercion Coercion
_        -> Expr' SBinder BinderId
forall bndr var. Expr' bndr var
ECoercion

cvtRealSrcSpan :: SrcLoc.RealSrcSpan -> SrcSpan
cvtRealSrcSpan :: RealSrcSpan -> SrcSpan
cvtRealSrcSpan RealSrcSpan
span =
  SrcSpan :: Text -> LineCol -> LineCol -> SrcSpan
Ast.SrcSpan { spanFile :: Text
spanFile  = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FastString -> String
forall a. Show a => a -> String
show (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
SrcLoc.srcSpanFile RealSrcSpan
span
              , spanStart :: LineCol
spanStart = Int -> Int -> LineCol
LineCol (RealSrcSpan -> Int
SrcLoc.srcSpanStartLine RealSrcSpan
span) (RealSrcSpan -> Int
SrcLoc.srcSpanStartCol RealSrcSpan
span)
              , spanEnd :: LineCol
spanEnd   = Int -> Int -> LineCol
LineCol (RealSrcSpan -> Int
SrcLoc.srcSpanEndLine RealSrcSpan
span) (RealSrcSpan -> Int
SrcLoc.srcSpanEndCol RealSrcSpan
span)
              }

cvtAlt :: HasEnv => CoreAlt -> Ast.SAlt
#if MIN_VERSION_ghc(9,2,0)
cvtAlt (CoreSyn.Alt con bs e) =
#else
cvtAlt :: Alt Var -> Alt' SBinder BinderId
cvtAlt (AltCon
con, [Var]
bs, CoreExpr
e) =
#endif
    AltCon
-> [SBinder] -> Expr' SBinder BinderId -> Alt' SBinder BinderId
forall bndr var.
AltCon -> [bndr] -> Expr' bndr var -> Alt' bndr var
Alt ((?env::Env) => AltCon -> AltCon
AltCon -> AltCon
cvtAltCon AltCon
con) ((Var -> SBinder) -> [Var] -> [SBinder]
forall a b. (a -> b) -> [a] -> [b]
map (?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder [Var]
bs) ((?env::Env) => CoreExpr -> Expr' SBinder BinderId
CoreExpr -> Expr' SBinder BinderId
cvtExpr CoreExpr
e)

cvtAltCon :: HasEnv => 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
$ (?env::Env) => OccName -> Text
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
$ (?env::Env) => Literal -> Lit
Literal -> Lit
cvtLit Literal
l
cvtAltCon AltCon
DEFAULT          = AltCon
Ast.AltDefault

cvtLit :: HasEnv => 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
$ (?env::Env) => FastString -> Text
FastString -> Text
fastStringToText  FastString
x
      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)
#if MIN_VERSION_ghc(9,0,0)
      Literal.LitNumber numty n ->
#else
      Literal.LitNumber LitNumType
numty Integer
n Type
_ ->
#endif
        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
#if MIN_VERSION_ghc(9,2,0)
          -- Lossy
          Literal.LitNumInt8 -> Ast.MachInt n
          Literal.LitNumInt16 -> Ast.MachInt n
          Literal.LitNumInt32 -> Ast.MachInt n
          Literal.LitNumWord8 -> Ast.MachWord n
          Literal.LitNumWord16 -> Ast.MachWord n
          Literal.LitNumWord32 -> Ast.MachWord n
#endif

#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 :: DynFlags -> String -> ModGuts -> Ast.SModule
cvtModule :: DynFlags -> String -> ModGuts -> SModule
cvtModule DynFlags
dflags String
phase ModGuts
guts =
    let ?env = Env {dflags}
    in (?env::Env) => String -> ModGuts -> SModule
String -> ModGuts -> SModule
cvtModule' String
phase ModGuts
guts

cvtModule' :: HasEnv => 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 (?env::Env) => CoreBind -> STopBinding
CoreBind -> STopBinding
cvtTopBind ([CoreBind] -> [STopBinding]) -> [CoreBind] -> [STopBinding]
forall a b. (a -> b) -> a -> b
$ ModGuts -> [CoreBind]
mg_binds ModGuts
guts)
  where
    name :: ModuleName
name = (?env::Env) => ModuleName -> ModuleName
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 :: HasEnv => 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
. (?env::Env) => FastString -> Text
FastString -> Text
fastStringToText (FastString -> Text)
-> (ModuleName -> FastString) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FastString
moduleNameFS

cvtType :: HasEnv => Type.Type -> Ast.SType
#if MIN_VERSION_ghc(9,0,0)
cvtType (Type.FunTy _flag _ a b) = Ast.FunTy (cvtType a) (cvtType b)
#elif 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 ((?env::Env) => Type -> Type' SBinder BinderId
Type -> Type' SBinder BinderId
cvtType Type
a) ((?env::Env) => Type -> Type' SBinder BinderId
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 ((?env::Env) => Type -> Type' SBinder BinderId
Type -> Type' SBinder BinderId
cvtType Type
a) ((?env::Env) => Type -> Type' SBinder BinderId
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 ((?env::Env) => TyCon -> TyCon
TyCon -> TyCon
cvtTyCon TyCon
tc) ((Type -> Type' SBinder BinderId)
-> [Type] -> [Type' SBinder BinderId]
forall a b. (a -> b) -> [a] -> [b]
map (?env::Env) => Type -> Type' SBinder BinderId
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 ((?env::Env) => Var -> SBinder
Var -> SBinder
cvtBinder Var
b) ((?env::Env) => Type -> Type' SBinder BinderId
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
_)      = (?env::Env) => Type -> Type' SBinder BinderId
Type -> Type' SBinder BinderId
cvtType Type
t
cvtType (Type.CoercionTy Coercion
_)    = Type' SBinder BinderId
forall bndr var. Type' bndr var
Ast.CoercionTy
#endif

cvtTyCon :: HasEnv => TyCon.TyCon -> Ast.TyCon
cvtTyCon :: TyCon -> TyCon
cvtTyCon TyCon
tc = Text -> Unique -> TyCon
TyCon ((?env::Env) => OccName -> Text
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)