X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnMonad.lhs;h=78f89184f7d3ea0f2e27dd747ad94b9a48616c57;hb=30cf375e0bc79a6b71074a5e0fd2ec393241a751;hp=eaaa862186bbfd1137a899126d7d15d2a2c6ce20;hpb=dabfa71f33eabc5a2d10959728f772aa016f1c84;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index eaaa862..78f8918 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -56,6 +56,7 @@ import Name ( Module(..), RdrName(..), isQual, getOccName ) import PrelInfo ( builtinNameInfo, BuiltinNames(..), BuiltinKeys(..) ) +import PrelMods ( pRELUDE ) import Pretty ( Pretty(..), PrettyRep ) import SrcLoc ( SrcLoc, mkUnknownSrcLoc ) import UniqFM ( UniqFM, emptyUFM ) @@ -368,30 +369,26 @@ lookup_val rdr lookup check do_err down@(RnDown _ _ locn (RnIface b_names b_key Nothing -> lookup_nonexisting_val b_names b_key imp_var us_var rdr lookup_nonexisting_val (b_names,_) b_key imp_var us_var rdr - = case rdr of - Qual _ _ -> -- builtin things *don't* have Qual names - lookup_or_create_implicit_val b_key imp_var us_var rdr - - Unqual n -> case (lookupFM b_names n) of - Nothing -> lookup_or_create_implicit_val b_key imp_var us_var rdr - Just xx -> returnSST xx + = let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) } + in case (lookupFM b_names str_mod) of + Nothing -> lookup_or_create_implicit_val b_key imp_var us_var rdr + Just xx -> returnSST xx lookup_or_create_implicit_val b_key imp_var us_var rdr = readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm) -> case lookupFM implicit_val_fm rdr of Just implicit -> returnSST implicit Nothing -> - (case rdr of - Qual _ _ -> get_unique us_var - Unqual n -> case (lookupFM b_key n) of - Just (u,_) -> returnSST u - _ -> get_unique us_var - ) `thenSST` \ uniq -> + (let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) } + in case (lookupFM b_key str_mod) of + Just (u,_) -> returnSST u + _ -> get_unique us_var + ) `thenSST` \ uniq -> let implicit = mkRnImplicit (mkImplicitName uniq rdr) new_val_fm = addToFM implicit_val_fm rdr implicit in - writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) `thenSST_` + writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) `thenSST_` returnSST implicit \end{code} @@ -429,13 +426,10 @@ lookup_tc rdr check mk_implicit err_str down@(RnDown _ _ locn (RnIface b_names b fail = failButContinueRn (mkRnUnbound rdr) (unknownNameErr err_str rdr locn) down lookup_nonexisting_tc check mk_implicit fail (_,b_names) b_key imp_var us_var rdr - = case rdr of - Qual _ _ -> -- builtin things *don't* have Qual names - lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr - - Unqual n -> case (lookupFM b_names n) of - Nothing -> lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr - Just xx -> returnSST xx + = let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) } + in case (lookupFM b_names str_mod) of + Nothing -> lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr + Just xx -> returnSST xx lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr = readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm) -> @@ -443,17 +437,16 @@ lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr Just implicit | check implicit -> returnSST implicit | otherwise -> fail Nothing -> - (case rdr of - Qual _ _ -> get_unique us_var - Unqual n -> case (lookupFM b_key n) of - Just (u,_) -> returnSST u - _ -> get_unique us_var - ) `thenSST` \ uniq -> + (let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) } + in case (lookupFM b_key str_mod) of + Just (u,_) -> returnSST u + _ -> get_unique us_var + ) `thenSST` \ uniq -> let implicit = mk_implicit (mkImplicitName uniq rdr) new_tc_fm = addToFM implicit_tc_fm rdr implicit in - writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) `thenSST_` + writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) `thenSST_` returnSST implicit \end{code}