Commit 1965e001 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-08-16 10:54:22 by simonmar]

Include fixity info in the output from :info.
parent a035c70f
......@@ -49,7 +49,8 @@ import HscMain ( initPersistentCompilerState )
import HscTypes
import RnEnv ( unQualInScope )
import Id ( idType, idName )
import Name ( Name, NamedThing(..), nameRdrName )
import Name ( Name, NamedThing(..), nameRdrName, nameModule,
isHomePackageName )
import NameEnv
import RdrName ( lookupRdrEnv, emptyRdrEnv )
import Module
......@@ -63,8 +64,10 @@ import ErrUtils ( showPass )
import SysTools ( cleanTempFilesExcept )
import Util
import Outputable
import BasicTypes ( Fixity, defaultFixity )
import Panic
import CmdLineOpts ( DynFlags(..) )
import IOExts
#ifdef GHCI
......@@ -180,13 +183,24 @@ moduleNameToModule mn
#ifdef GHCI
cmInfoThing :: CmState -> DynFlags -> String
-> IO (CmState, PrintUnqualified, [TyThing])
-> IO (CmState, PrintUnqualified, [(TyThing,Fixity)])
cmInfoThing cmstate dflags id
= do (new_pcs, things) <- hscThing dflags hst hit pcs icontext id
return (cmstate{ pcs=new_pcs }, unqual, things)
let pairs = map (\x -> (x, getFixity new_pcs (getName x))) things
return (cmstate{ pcs=new_pcs }, unqual, pairs)
where
CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } = cmstate
unqual = getUnqual pcs hit icontext
getFixity :: PersistentCompilerState -> Name -> Fixity
getFixity pcs name
| Just iface <- lookupModuleEnv iface_table (nameModule name),
Just fixity <- lookupNameEnv (mi_fixities iface) name
= fixity
| otherwise
= defaultFixity
where iface_table | isHomePackageName name = hit
| otherwise = pcs_PIT pcs
#endif
-----------------------------------------------------------------------------
......
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.89 2001/08/15 15:50:41 simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.90 2001/08/16 10:54:22 simonmar Exp $
--
-- GHC Interactive User Interface
--
......@@ -31,7 +31,8 @@ import Class ( className )
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(..) )
......@@ -387,14 +388,20 @@ info s = do
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)]
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment