From d74118a7d0d0b95e3525e5689491d529ff992065 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 20 Apr 2000 12:50:18 +0000 Subject: [PATCH] [project @ 2000-04-20 12:50:18 by simonpj] Dont strip directory prefix when printing src-locs --- ghc/compiler/basicTypes/MkId.lhs | 5 +++-- ghc/compiler/basicTypes/SrcLoc.lhs | 8 ++------ 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index 661e3f5..8d93e73 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -49,7 +49,7 @@ import Type ( Type, ClassContext, mkDictTy, mkDictTys, mkTyConApp, mkTyVarTys, ) import PprType ( pprParendType ) import Module ( Module ) -import CoreUtils ( mkInlineMe ) +import CoreUtils ( exprType, mkInlineMe ) import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon ) import Subst ( mkTopTyVarSubst, substClasses ) import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons, isDataTyCon, @@ -429,9 +429,10 @@ there's nothing to do. ToDo: unify with mkRecordSelId. \begin{code} -mkDictSelId name clas ty +mkDictSelId name clas = sel_id where + ty = exprType rhs sel_id = mkId name ty info field_lbl = mkFieldLabel name ty tag tag = assoc "MkId.mkDictSelId" (classSelIds clas `zip` allFieldLabelTags) sel_id diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs index 89947d7..3dccd51 100644 --- a/ghc/compiler/basicTypes/SrcLoc.lhs +++ b/ghc/compiler/basicTypes/SrcLoc.lhs @@ -132,12 +132,8 @@ instance Outputable SrcLoc where hcat [text "{-# LINE ", int IBOX(src_line), space, char '\"', ptext src_path, text " #-}"] where - src_file = remove_directory_prefix (unpackFS src_path) - - remove_directory_prefix path = case break (== '/') path of - (filename, []) -> filename - (prefix, slash : rest) -> ASSERT( slash == '/' ) - remove_directory_prefix rest + src_file = unpackFS src_path -- Leave the directory prefix intact, + -- so emacs can find the file ppr (UnhelpfulSrcLoc s) = ptext s -- 1.7.10.4