[project @ 2000-04-20 12:50:18 by simonpj]
authorsimonpj <unknown>
Thu, 20 Apr 2000 12:50:18 +0000 (12:50 +0000)
committersimonpj <unknown>
Thu, 20 Apr 2000 12:50:18 +0000 (12:50 +0000)
Dont strip directory prefix when printing src-locs

ghc/compiler/basicTypes/MkId.lhs
ghc/compiler/basicTypes/SrcLoc.lhs

index 661e3f5..8d93e73 100644 (file)
@@ -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
index 89947d7..3dccd51 100644 (file)
@@ -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