-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.88 2001/08/15 15:39:59 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.90 2001/08/16 10:54:22 simonmar Exp $
--
-- GHC Interactive User Interface
--
import Linker
import Finder ( flushPackageCache )
import Util
-import Id ( isRecordSelector, isDataConWrapId, idName )
+import Id ( isRecordSelector, recordSelectorFieldLabel,
+ isDataConWrapId, idName )
import Class ( className )
-import TyCon ( tyConName )
+import TyCon ( tyConName, tyConClass_maybe )
+import FieldLabel ( fieldLabelTyCon )
import SrcLoc ( isGoodSrcLoc )
-import Name ( Name, isHomePackageName, nameSrcLoc )
+import Name ( Name, isHomePackageName, nameSrcLoc, NamedThing(..) )
+import BasicTypes ( defaultFixity )
import Outputable
import CmdLineOpts ( DynFlag(..), getDynFlags, saveDynFlags, restoreDynFlags, dopt_unset )
import Panic ( GhcException(..) )
let
infoThings cms [] = return cms
infoThings cms (name:names) = do
- (cms, unqual, ty_things) <- io (cmInfoThing cms dflags name)
+ (cms, unqual, stuff) <- io (cmInfoThing cms dflags name)
io (putStrLn (showSDocForUser unqual (
- vcat (intersperse (text "") (map showThing ty_things))))
+ vcat (intersperse (text "") (map showThing stuff))))
)
infoThings cms names
- showThing ty_thing = vcat [ text "-- " <> showTyThing ty_thing,
- ppr (ifaceTyCls ty_thing) ]
+ showThing (ty_thing, fixity)
+ = vcat [ text "-- " <> showTyThing ty_thing,
+ showFixity fixity (getName ty_thing),
+ ppr (ifaceTyCls ty_thing) ]
+
+ showFixity fix name
+ | fix == defaultFixity = empty
+ | otherwise = ppr fix <+> ppr name
showTyThing (AClass cl)
= hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
showTyThing (ATyCon ty)
= hcat [ppr ty, text " is a type constructor", showSrcLoc (tyConName ty)]
showTyThing (AnId id)
- = hcat [ppr id, text " is a ", text (idDescr id), showSrcLoc (idName id)]
+ = hcat [ppr id, text " is a ", idDescr id, showSrcLoc (idName id)]
idDescr id
- | isRecordSelector id = "record selector"
- | isDataConWrapId id = "data constructor"
- | otherwise = "variable"
+ | isRecordSelector id =
+ case tyConClass_maybe (fieldLabelTyCon (
+ recordSelectorFieldLabel id)) of
+ Nothing -> text "record selector"
+ Just c -> text "method in class " <> ppr c
+ | isDataConWrapId id = text "data constructor"
+ | otherwise = text "variable"
-- also print out the source location for home things
showSrcLoc name