X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FRdrHsSyn.lhs;h=7629070b5862d6aca00b2b22b41182358ced5533;hb=91c750cbd18e3d610b0db498ded38d5b3c5adfac;hp=9bc63ea40ee4ddec290f7d4aefdec47b7a72c669;hpb=d4e38936bf64bcd3dc301ec404406bbff20f01d5;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs index 9bc63ea..7629070 100644 --- a/ghc/compiler/parser/RdrHsSyn.lhs +++ b/ghc/compiler/parser/RdrHsSyn.lhs @@ -43,9 +43,7 @@ module RdrHsSyn ( RdrMatch(..), SigConverter, - extractHsTyRdrNames, - extractHsTyRdrTyVars, extractHsTysRdrTyVars, - extractRuleBndrsTyVars, + extractHsTyRdrNames, extractHsTyRdrTyVars, extractHsCtxtRdrTyVars, extractGenericPatTyVars, mkHsOpApp, mkClassDecl, mkClassOpSigDM, mkConDecl, @@ -66,8 +64,7 @@ import OccName ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc, mkGenOcc2, ) import PrelNames ( minusName, negateName, fromIntegerName, fromRationalName ) -import RdrName ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc, - ) +import RdrName ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc, isRdrTyVar ) import List ( nub ) import BasicTypes ( RecFlag(..) ) import Class ( DefMeth (..) ) @@ -126,20 +123,11 @@ type RdrNameHsRecordBinds = HsRecordBinds RdrName RdrNamePat It's used when making the for-alls explicit. \begin{code} -extractHsTyRdrNames :: HsType RdrName -> [RdrName] +extractHsTyRdrNames :: RdrNameHsType -> [RdrName] extractHsTyRdrNames ty = nub (extract_ty ty []) -extractHsTyRdrTyVars :: RdrNameHsType -> [RdrName] -extractHsTyRdrTyVars ty = filter isRdrTyVar (extractHsTyRdrNames ty) - -extractHsTysRdrTyVars :: [RdrNameHsType] -> [RdrName] -extractHsTysRdrTyVars tys = filter isRdrTyVar (nub (extract_tys tys)) - -extractRuleBndrsTyVars :: [RuleBndr RdrName] -> [RdrName] -extractRuleBndrsTyVars bndrs = filter isRdrTyVar (nub (foldr go [] bndrs)) - where - go (RuleBndr _) acc = acc - go (RuleBndrSig _ ty) acc = extract_ty ty acc +extractHsTyRdrTyVars :: RdrNameHsType -> [RdrName] +extractHsTyRdrTyVars ty = nub (filter isRdrTyVar (extract_ty ty [])) extractHsCtxtRdrNames :: HsContext RdrName -> [RdrName] extractHsCtxtRdrNames ty = nub (extract_ctxt ty []) @@ -181,8 +169,8 @@ extractGenericPatTyVars binds get (FunMonoBind _ _ ms _) acc = foldr get_m acc ms get other acc = acc - get_m (Match _ (TypePatIn ty : _) _ _) acc = extract_ty ty acc - get_m other acc = acc + get_m (Match (TypePatIn ty : _) _ _) acc = extract_ty ty acc + get_m other acc = acc \end{code} @@ -224,7 +212,6 @@ mkClassDecl cxt cname tyvars fds sigs mbinds loc -- superclasses both called C!) new_names = mkClassDeclSysNames (tname, dname, dwname, sc_sel_names) --- mkTyData :: ?? mkTyData new_or_data context tname list_var list_con i maybe src = let t_occ = rdrNameOcc tname name1 = mkRdrUnqual (mkGenOcc1 t_occ)