X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsUtils.lhs;h=f8efa6cfb94f206e7047953e32c87d6b486eacac;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=2e33d4e361d654d9f309153cea55bda2ab9f72fa;hpb=70b59eb3397c68f10ce429c0ffcf5ed63d86d3d3;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsUtils.lhs b/ghc/compiler/hsSyn/HsUtils.lhs index 2e33d4e..f8efa6c 100644 --- a/ghc/compiler/hsSyn/HsUtils.lhs +++ b/ghc/compiler/hsSyn/HsUtils.lhs @@ -27,7 +27,7 @@ import RdrName ( RdrName, getRdrName, mkRdrUnqual ) import Var ( Id ) import Type ( Type ) import DataCon ( DataCon, dataConWrapId, dataConSourceArity ) -import OccName ( mkVarOcc ) +import OccName ( mkVarOccFS ) import Name ( Name ) import BasicTypes ( RecFlag(..) ) import SrcLoc @@ -100,7 +100,7 @@ mkHsDictLet binds expr | isEmptyLHsBinds binds = expr | otherwise = L (getLoc expr) (HsLet (HsValBinds val_binds) expr) where - val_binds = ValBindsOut [(Recursive, binds)] + val_binds = ValBindsOut [(Recursive, binds)] [] mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id -- Used for constructing dictinoary terms etc, so no locations @@ -136,11 +136,15 @@ mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2 mkHsSplice e = HsSplice unqualSplice e -unqualSplice = mkRdrUnqual (mkVarOcc FSLIT("splice")) +unqualSplice = mkRdrUnqual (mkVarOccFS FSLIT("splice")) -- A name (uniquified later) to -- identify the splice mkHsString s = HsString (mkFastString s) + +------------- +userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)] +userHsTyVarBndrs bndrs = [ L loc (UserTyVar v) | L loc v <- bndrs ] \end{code} @@ -279,8 +283,8 @@ collectLocalBinders (HsIPBinds _) = [] collectLocalBinders EmptyLocalBinds = [] collectHsValBinders :: HsValBinds name -> [Located name] -collectHsValBinders (ValBindsIn binds sigs) = collectHsBindLocatedBinders binds -collectHsValBinders (ValBindsOut binds) = foldr collect_one [] binds +collectHsValBinders (ValBindsIn binds sigs) = collectHsBindLocatedBinders binds +collectHsValBinders (ValBindsOut binds sigs) = foldr collect_one [] binds where collect_one (_,binds) acc = foldrBag (collectAcc . unLoc) acc binds @@ -312,8 +316,8 @@ collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds Get all the pattern type signatures out of a bunch of bindings \begin{code} -collectSigTysFromHsBinds :: [LHsBind name] -> [LHsType name] -collectSigTysFromHsBinds binds = concat (map collectSigTysFromHsBind binds) +collectSigTysFromHsBinds :: LHsBinds name -> [LHsType name] +collectSigTysFromHsBinds binds = concatMap collectSigTysFromHsBind (bagToList binds) collectSigTysFromHsBind :: LHsBind name -> [LHsType name] collectSigTysFromHsBind bind