From 1c0228a91d0b3ba02697c092818333d95fcc3100 Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Wed, 24 Jun 2009 17:38:52 +0200 Subject: [PATCH] No longer use a view pattern in HsTools. This prevents GHC from giving an unwarranted warning, due to view pattern support being incomplete. --- HsTools.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/HsTools.hs b/HsTools.hs index 967db18..0f3e463 100644 --- a/HsTools.hs +++ b/HsTools.hs @@ -126,14 +126,16 @@ mkId rdr_name = do -- | Translate a core Type to an HsType. Far from complete so far. coreToHsType :: Type.Type -> HsTypes.LHsType RdrName.RdrName -- Translate TyConApps -coreToHsType (Type.splitTyConApp_maybe -> Just (tycon, tys)) = - foldl (\t a -> SrcLoc.noLoc $ HsTypes.HsAppTy t a) tycon_ty (map coreToHsType tys) - where - tycon_name = TyCon.tyConName tycon - mod_name = Module.moduleName $ Name.nameModule tycon_name - occ_name = Name.nameOccName tycon_name - tycon_rdrname = RdrName.mkRdrQual mod_name occ_name - tycon_ty = SrcLoc.noLoc $ HsTypes.HsTyVar tycon_rdrname +coreToHsType ty = case Type.splitTyConApp_maybe ty of + Just (tycon, tys) -> + foldl (\t a -> SrcLoc.noLoc $ HsTypes.HsAppTy t a) tycon_ty (map coreToHsType tys) + where + tycon_name = TyCon.tyConName tycon + mod_name = Module.moduleName $ Name.nameModule tycon_name + occ_name = Name.nameOccName tycon_name + tycon_rdrname = RdrName.mkRdrQual mod_name occ_name + tycon_ty = SrcLoc.noLoc $ HsTypes.HsTyVar tycon_rdrname + Nothing -> error $ "HsTools.coreToHsType Cannot translate non-tycon type" -- | Evaluate a CoreExpr and return its value. For this to work, the caller -- should already know the result type for sure, since the result value is -- 2.30.2