Dear GHC Devs, Because of the unwieldy nature of the data that the GHC type checker outputs, I am trying to convert a GHC 'Type' [1] to a haskell-src-ext 'Type' [2].
The translation does not need to be perfect for now, but I would at least like to be able to translate function types and types that involve type-class constraints. (See my initial attempt in attachment) Has this ever been done before? Could you point me to some documentation on GHC's 'Type' [1] that could help me with writing this function? (The comments in code aren't nearly enough for me.) In particular, I am having trouble finding type class constraints in the 'Type'. Thank you for your time. [1]: https://downloads.haskell.org/~ghc/8.0.2/docs/html/libraries/ghc-8.0.2/src/TyCoRep.html#Type [2]: https://hackage.haskell.org/package/haskell-src-exts-1.18.2/docs/Language-Haskell-Exts-Syntax.html#t:Type -- Tom Sydney Kerckhove
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module EasySpec.Discover.Gather where
import Import
import GHC
import GHC.Paths (libdir)
import OccName
import RdrName
import TcRnTypes
import TyCoRep
import TyCon
import Type
import Var
import Language.Haskell.Exts.Syntax as H
data EasyId = EasyId
{ easyName :: EasyName
, easyType :: EasyType
} deriving (Show, Eq)
type EasyName = H.Name ()
type EasyType = H.Type ()
toEasyId :: GHC.Id -> EasyId
toEasyId i =
EasyId
{ easyName = toEasyName $ Var.varName i
, easyType = toEasyType $ Var.varType i
}
toEasyName :: Monoid a => GHC.Name -> H.Name a
toEasyName n = Ident mempty $ showName n
toEasyType :: Monoid a => GHC.Type -> H.Type a
toEasyType ty =
case splitFunTy_maybe ty of
Nothing -> go ty
Just (tf, tt) -> H.TyFun mempty (toEasyType tf) (toEasyType tt)
where
go t =
case t of
TyVarTy i -> TyVar mempty $ toEasyName $ Var.varName i
AppTy t1 t2 -> TyApp mempty (toEasyType t1) (toEasyType t2)
TyConApp tc kots ->
let dres =
foldl
(TyApp mempty)
(TyCon mempty $
UnQual mempty $ toEasyName $ tyConName tc)
(map toEasyType kots)
in case tyConClass_maybe tc of
Just _ -> dres
Nothing ->
case (showName (tyConName tc), kots) of
("[]", [lt]) -> TyList mempty $ toEasyType lt
_ -> dres
ForAllTy _ t' -> toEasyType t'
_ -> error "Not implemented yet"
signature.asc
Description: PGP signature
_______________________________________________ ghc-devs mailing list [email protected] http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
