Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,323
Issues
4,323
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
377
Merge Requests
377
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
5f67848a
Commit
5f67848a
authored
Oct 31, 2000
by
simonpj
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[project @ 2000-10-31 12:07:43 by simonpj]
Improve MkIface; get ready for NameEnv.lhs
parent
bad73fe5
Changes
17
Hide whitespace changes
Inline
Side-by-side
Showing
17 changed files
with
100 additions
and
94 deletions
+100
-94
ghc/compiler/basicTypes/Name.lhs
ghc/compiler/basicTypes/Name.lhs
+4
-2
ghc/compiler/codeGen/CodeGen.lhs
ghc/compiler/codeGen/CodeGen.lhs
+3
-6
ghc/compiler/deSugar/DsMonad.lhs
ghc/compiler/deSugar/DsMonad.lhs
+2
-1
ghc/compiler/main/CodeOutput.lhs
ghc/compiler/main/CodeOutput.lhs
+10
-8
ghc/compiler/main/HscMain.lhs
ghc/compiler/main/HscMain.lhs
+6
-5
ghc/compiler/main/HscTypes.lhs
ghc/compiler/main/HscTypes.lhs
+3
-5
ghc/compiler/main/MkIface.lhs
ghc/compiler/main/MkIface.lhs
+56
-45
ghc/compiler/rename/Rename.lhs
ghc/compiler/rename/Rename.lhs
+1
-1
ghc/compiler/rename/RnEnv.lhs
ghc/compiler/rename/RnEnv.lhs
+1
-1
ghc/compiler/rename/RnHiFiles.lhs
ghc/compiler/rename/RnHiFiles.lhs
+1
-1
ghc/compiler/rename/RnIfaces.lhs
ghc/compiler/rename/RnIfaces.lhs
+1
-1
ghc/compiler/rename/RnMonad.lhs
ghc/compiler/rename/RnMonad.lhs
+2
-3
ghc/compiler/typecheck/TcClassDcl.lhs
ghc/compiler/typecheck/TcClassDcl.lhs
+2
-3
ghc/compiler/typecheck/TcEnv.lhs
ghc/compiler/typecheck/TcEnv.lhs
+2
-3
ghc/compiler/typecheck/TcModule.lhs
ghc/compiler/typecheck/TcModule.lhs
+2
-3
ghc/compiler/typecheck/TcTyClsDecls.lhs
ghc/compiler/typecheck/TcTyClsDecls.lhs
+2
-3
ghc/compiler/types/PprType.lhs
ghc/compiler/types/PprType.lhs
+2
-3
No files found.
ghc/compiler/basicTypes/Name.lhs
View file @
5f67848a
...
...
@@ -29,7 +29,7 @@ module Name (
-- Environment
NameEnv, mkNameEnv,
emptyNameEnv, unitNameEnv, nameEnvElts,
extendNameEnv_C, extendNameEnv,
extendNameEnv_C, extendNameEnv,
foldNameEnv,
plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList,
lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv,
...
...
@@ -49,8 +49,8 @@ import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( builtinSrcLoc, noSrcLoc, SrcLoc )
import Unique ( Unique, Uniquable(..), u2i, pprUnique, pprUnique10 )
import Maybes ( expectJust )
import FastTypes
import Maybes ( expectJust )
import UniqFM
import Outputable
\end{code}
...
...
@@ -430,8 +430,10 @@ unitNameEnv :: Name -> a -> NameEnv a
lookupNameEnv :: NameEnv a -> Name -> Maybe a
lookupNameEnv_NF :: NameEnv a -> Name -> a
mapNameEnv :: (a->b) -> NameEnv a -> NameEnv b
foldNameEnv :: (a -> b -> b) -> b -> NameEnv a -> b
emptyNameEnv = emptyUFM
foldNameEnv = foldUFM
mkNameEnv = listToUFM
nameEnvElts = eltsUFM
extendNameEnv_C = addToUFM_C
...
...
ghc/compiler/codeGen/CodeGen.lhs
View file @
5f67848a
...
...
@@ -38,7 +38,6 @@ import Id ( Id, idName )
import Module ( Module )
import PrimRep ( PrimRep(..) )
import TyCon ( TyCon, isDataTyCon )
import Class ( Class, classTyCon )
import BasicTypes ( TopLevelFlag(..) )
import UniqSupply ( mkSplitUniqSupply )
import ErrUtils ( dumpIfSet_dyn )
...
...
@@ -55,12 +54,12 @@ codeGen :: DynFlags
[CostCentre], -- "extern" cost-centres needing declaring
[CostCentreStack]) -- Pre-defined "singleton" cost centre stacks
-> [Id] -- foreign-exported binders
-> [TyCon]
-> [Class] -- Local tycons and
classes
-> [TyCon]
-- Local tycons, including ones from
classes
-> [(StgBinding,[Id])] -- Bindings to convert, with SRTs
-> IO AbstractC -- Output
codeGen dflags mod_name imported_modules cost_centre_info fe_binders
tycons
classes
stg_binds
tycons stg_binds
= mkSplitUniqSupply 'f' >>= \ fl_uniqs -> -- absC flattener
let
datatype_stuff = genStaticConBits cinfo data_tycons
...
...
@@ -82,9 +81,7 @@ codeGen dflags mod_name imported_modules cost_centre_info fe_binders
return flat_abstractC
where
data_tycons = filter isDataTyCon (tycons ++ map classTyCon classes)
-- Generate info tables for the data constrs arising
-- from class decls as well
data_tycons = filter isDataTyCon tycons
maybe_split = if opt_EnsureSplittableC
then CSplitMarker
...
...
ghc/compiler/deSugar/DsMonad.lhs
View file @
5f67848a
...
...
@@ -38,7 +38,8 @@ import UniqSupply ( initUs_, splitUniqSupply, uniqFromSupply, uniqsFromSupply,
UniqSM, UniqSupply )
import Unique ( Unique )
import Util ( zipWithEqual )
import Name ( Name, lookupNameEnv )
import Name ( Name )
import Name ( lookupNameEnv )
import HscTypes ( HomeSymbolTable, PersistentCompilerState(..),
TyThing(..), TypeEnv, lookupType )
import CmdLineOpts ( DynFlags )
...
...
ghc/compiler/main/CodeOutput.lhs
View file @
5f67848a
...
...
@@ -47,16 +47,15 @@ import IO ( IOMode(..), hClose, openFile, Handle )
\begin{code}
codeOutput :: DynFlags
-> Module
-> [TyCon]
-> [Class] -- Local tycons and classe
s
-> [TyCon]
-- Local tycon
s
-> [CoreBind] -- Core bindings
-> [(StgBinding,[Id])] -- The STG program with SRTs
-> SDoc -- C stubs for foreign exported functions
-> SDoc -- Header file prototype for foreign exported functions
-> AbstractC -- Compiled abstract C
-> UniqSupply
-> IO (Maybe FilePath, Maybe FilePath)
codeOutput dflags mod_name tycons c
lasses c
ore_binds stg_binds
c_code h_code flat_abstractC
ncg_uniqs
codeOutput dflags mod_name tycons core_binds stg_binds
c_code h_code flat_abstractC
= -- You can have C (c_output) or assembly-language (ncg_output),
-- but not both. [Allowing for both gives a space leak on
-- flat_abstractC. WDP 94/10]
...
...
@@ -67,7 +66,7 @@ codeOutput dflags mod_name tycons classes core_binds stg_binds
stub_names <- outputForeignStubs dflags c_code h_code
case dopt_HscLang dflags of
HscInterpreted -> return stub_names
HscAsm -> outputAsm dflags filenm flat_abstractC
ncg_uniqs
HscAsm -> outputAsm dflags filenm flat_abstractC
>> return stub_names
HscC -> outputC dflags filenm flat_abstractC
>> return stub_names
...
...
@@ -104,15 +103,18 @@ outputC dflags filenm flat_absC
%************************************************************************
\begin{code}
outputAsm dflags filenm flat_absC
ncg_uniqs
outputAsm dflags filenm flat_absC
#ifndef OMIT_NATIVE_CODEGEN
= do dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
= do ncg_uniqs <- mkSplitUniqSupply 'n'
let
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
in
dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
doOutput filenm ( \f -> printForAsm f ncg_output_d)
where
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
#else /* OMIT_NATIVE_CODEGEN */
...
...
ghc/compiler/main/HscMain.lhs
View file @
5f67848a
...
...
@@ -57,7 +57,8 @@ import InterpSyn ( UnlinkedIBind )
import StgInterp ( ItblEnv )
import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM )
import OccName ( OccName )
import Name ( Name, nameModule, emptyNameEnv, nameOccName, getName )
import Name ( Name, nameModule, nameOccName, getName )
import Name ( emptyNameEnv )
import Module ( Module, lookupModuleEnvByName )
\end{code}
...
...
@@ -258,22 +259,22 @@ restOfCodeGeneration dflags toInterp this_mod imported_module_names cost_centre_
= do (ibinds,itbl_env)
<- stgToInterpSyn (map fst stg_binds) local_tycons local_classes
return (Nothing, Nothing, Just (ibinds,itbl_env))
| otherwise
= do -------------------------- Code generation -------------------------------
show_pass dflags "CodeGen"
-- _scc_ "CodeGen"
abstractC <- codeGen dflags this_mod imported_modules
cost_centre_info fe_binders
local_tycons
local_classes
stg_binds
local_tycons stg_binds
-------------------------- Code output -------------------------------
show_pass dflags "CodeOutput"
-- _scc_ "CodeOutput"
ncg_uniqs <- mkSplitUniqSupply 'n'
(maybe_stub_h_name, maybe_stub_c_name)
<- codeOutput dflags this_mod local_tycons
local_classes
<- codeOutput dflags this_mod local_tycons
oa_tidy_binds stg_binds
c_code h_code abstractC
ncg_uniqs
c_code h_code abstractC
return (maybe_stub_h_name, maybe_stub_c_name, Nothing)
where
...
...
ghc/compiler/main/HscTypes.lhs
View file @
5f67848a
...
...
@@ -45,11 +45,9 @@ module HscTypes (
#include "HsVersions.h"
import RdrName ( RdrNameEnv, emptyRdrEnv )
import Name ( Name, NameEnv, NamedThing,
emptyNameEnv, extendNameEnv,
lookupNameEnv, emptyNameEnv, nameEnvElts,
isLocallyDefined, getName, nameModule,
nameSrcLoc )
import Name ( Name, NamedThing, isLocallyDefined,
getName, nameModule, nameSrcLoc )
import Name -- Env
import NameSet ( NameSet )
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
...
...
ghc/compiler/main/MkIface.lhs
View file @
5f67848a
...
...
@@ -42,10 +42,9 @@ import CoreSyn ( CoreExpr, CoreBind, Bind(..), CoreRule(..), IdCoreRule,
import CoreFVs ( exprSomeFreeVars, ruleSomeLhsFreeVars, ruleSomeFreeVars )
import CoreUnfold ( okToUnfoldInHiFile, mkTopUnfolding, neverUnfold, unfoldingTemplate, noUnfolding )
import Name ( isLocallyDefined, getName,
Name, NamedThing(..),
plusNameEnv, lookupNameEnv, emptyNameEnv, mkNameEnv,
extendNameEnv, lookupNameEnv_NF, nameEnvElts
Name, NamedThing(..)
)
import Name -- Env
import OccName ( pprOccName )
import TyCon ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
tyConTheta, tyConTyVars, tyConDataCons, tyConFamilySize
...
...
@@ -84,6 +83,14 @@ mkModDetails type_env dfun_ids tidy_binds stg_ids orphan_rules
-- a) keeping the types and classes
-- b) removing all Ids, and Ids with correct IdInfo
-- gotten from the bindings
-- From (b) we keep only those Ids with Global names, plus Ids
-- accessible from them (notably via unfoldings)
-- This truncates the type environment to include only the
-- exported Ids and things needed from them, which saves space
--
-- However, we do keep things like constructors, which should not appear
-- in interface files, because they are needed by importing modules when
-- using the compilation manager
new_type_env = mkNameEnv [(getName tycl, tycl) | tycl <- orig_type_env, isTyClThing tycl]
`plusNameEnv`
mkNameEnv [(idName id, AnId id) | id <- final_ids]
...
...
@@ -136,7 +143,7 @@ completeIface maybe_old_iface new_iface mod_details
dcl_rules = rule_dcls }
inst_dcls = map ifaceInstance (md_insts mod_details)
ty_cls_dcls =
map ifaceTyCls (nameEnvElts (md_types mod_details)
)
ty_cls_dcls =
foldNameEnv ifaceTyCls [] (md_types mod_details
)
rule_dcls = map ifaceRule (md_rules mod_details)
\end{code}
...
...
@@ -148,19 +155,21 @@ completeIface maybe_old_iface new_iface mod_details
%************************************************************************
\begin{code}
ifaceTyCls :: TyThing -> RenamedTyClDecl
ifaceTyCls (AClass clas)
= ClassDecl (toHsContext sc_theta)
(getName clas)
(toHsTyVars clas_tyvars)
(toHsFDs clas_fds)
(map toClassOpSig op_stuff)
EmptyMonoBinds
[] noSrcLoc
ifaceTyCls :: TyThing -> [RenamedTyClDecl] -> [RenamedTyClDecl]
ifaceTyCls (AClass clas) so_far
= cls_decl : so_far
where
(clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
cls_decl = ClassDecl (toHsContext sc_theta)
(getName clas)
(toHsTyVars clas_tyvars)
(toHsFDs clas_fds)
(map toClassOpSig op_stuff)
EmptyMonoBinds
[] noSrcLoc
(clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
toClassOpSig (sel_id, def_meth)
toClassOpSig (sel_id, def_meth)
= ASSERT(sel_tyvars == clas_tyvars)
ClassOpSig (getName sel_id) (Just def_meth') (toHsType op_ty) noSrcLoc
where
...
...
@@ -170,22 +179,26 @@ ifaceTyCls (AClass clas)
GenDefMeth -> GenDefMeth
DefMeth id -> DefMeth (getName id)
ifaceTyCls (ATyCon tycon)
| isSynTyCon tycon
= TySynonym (getName tycon)(toHsTyVars tyvars) (toHsType ty) noSrcLoc
where
(tyvars, ty) = getSynTyConDefn tycon
ifaceTyCls (ATyCon tycon)
| isAlgTyCon tycon
= TyData new_or_data (toHsContext (tyConTheta tycon))
(getName tycon)
(toHsTyVars tyvars)
(map ifaceConDecl (tyConDataCons tycon))
(tyConFamilySize tycon)
Nothing noSrcLoc (panic "gen1") (panic "gen2")
ifaceTyCls (ATyCon tycon) so_far
= ty_decl : so_far
where
tyvars = tyConTyVars tycon
ty_decl | isSynTyCon tycon
= TySynonym (getName tycon)(toHsTyVars tyvars)
(toHsType syn_ty) noSrcLoc
| isAlgTyCon tycon
= TyData new_or_data (toHsContext (tyConTheta tycon))
(getName tycon)
(toHsTyVars tyvars)
(map ifaceConDecl (tyConDataCons tycon))
(tyConFamilySize tycon)
Nothing noSrcLoc (panic "gen1") (panic "gen2")
| otherwise = pprPanic "ifaceTyCls" (ppr tycon)
tyvars = tyConTyVars tycon
(_, syn_ty) = getSynTyConDefn tycon
new_or_data | isNewTyCon tycon = NewType
| otherwise = DataType
...
...
@@ -212,11 +225,12 @@ ifaceTyCls (ATyCon tycon)
mk_field strict_mark field_label
= ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
ifaceTyCls (ATyCon tycon) = pprPanic "ifaceTyCls" (ppr tycon)
ifaceTyCls (AnId id)
= IfaceSig (getName id) (toHsType id_type) hs_idinfo noSrcLoc
ifaceTyCls (AnId id) so_far
| omitIfaceSigForId id = so_far
| otherwise = iface_sig : so_far
where
iface_sig = IfaceSig (getName id) (toHsType id_type) hs_idinfo noSrcLoc
id_type = idType id
id_info = idInfo id
...
...
@@ -326,17 +340,11 @@ bindsToIds needed_ids codegen_ids binds
| otherwise = emitted
go needed (NonRec id rhs : binds) emitted
| need_id needed id
= if omitIfaceSigForId id then
go (needed `delVarSet` id) binds (id:emitted)
else
go ((needed `unionVarSet` extras) `delVarSet` id)
binds
(new_id:emitted)
| otherwise
= go needed binds emitted
| need_id needed id = go new_needed binds (new_id:emitted)
| otherwise = go needed binds emitted
where
(new_id, extras) = mkFinalId codegen_ids False id rhs
new_needed = (needed `unionVarSet` extras) `delVarSet` id
-- Recursive groups are a bit more of a pain. We may only need one to
-- start with, but it may call out the next one, and so on. So we
...
...
@@ -369,12 +377,15 @@ bindsToIds needed_ids codegen_ids binds
\begin{code}
mkFinalId :: IdSet -- The Ids with arity info from the code generator
-> Bool
-- True <=> recursive, so don't include unfolding
-> Bool -- True <=> recursive, so don't include unfolding
-> Id
-> CoreExpr -- The Id's right hand side
-> (Id, IdSet)
-- The emitted id, plus any *extra* needed Ids
-> (Id, IdSet) -- The emitted id, plus any *extra* needed Ids
mkFinalId codegen_ids is_rec id rhs
| omitIfaceSigForId id
= (id, emptyVarSet) -- An optimisation for top-level constructors and suchlike
| otherwise
= (id `setIdInfo` new_idinfo, new_needed_ids)
where
core_idinfo = idInfo id
...
...
ghc/compiler/rename/Rename.lhs
View file @
5f67848a
...
...
@@ -39,8 +39,8 @@ import Module ( Module, ModuleName, WhereFrom(..),
import Name ( Name, NamedThing(..), getSrcLoc,
nameIsLocalOrFrom,
nameOccName, nameModule,
mkNameEnv, nameEnvElts, extendNameEnv
)
import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
import RdrName ( elemRdrEnv )
import OccName ( occNameFlavour )
import NameSet
...
...
ghc/compiler/rename/RnEnv.lhs
View file @
5f67848a
...
...
@@ -22,9 +22,9 @@ import Name ( Name, NamedThing(..),
getSrcLoc,
mkLocalName, mkImportedLocalName, mkGlobalName,
mkIPName, nameOccName, nameModule_maybe,
extendNameEnv_C, plusNameEnv_C, nameEnvElts,
setNameModuleAndLoc
)
import Name ( extendNameEnv_C, plusNameEnv_C, nameEnvElts )
import NameSet
import OccName ( OccName, occNameUserString, occNameFlavour )
import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS )
...
...
ghc/compiler/rename/RnHiFiles.lhs
View file @
5f67848a
...
...
@@ -42,8 +42,8 @@ import ParseIface ( parseIface, IfaceStuff(..) )
import Name ( Name {-instance NamedThing-}, nameOccName,
nameModule, isLocalName, nameIsLocalOrFrom,
NamedThing(..),
mkNameEnv, extendNameEnv
)
import Name ( mkNameEnv, extendNameEnv )
import Module ( Module,
moduleName, isModuleInThisPackage,
ModuleName, WhereFrom(..),
...
...
ghc/compiler/rename/RnIfaces.lhs
View file @
5f67848a
...
...
@@ -38,8 +38,8 @@ import TyCon ( isSynTyCon, getSynTyConDefn )
import Name ( Name {-instance NamedThing-}, nameOccName,
nameModule, isLocalName, nameUnique,
NamedThing(..),
elemNameEnv
)
import Name ( elemNameEnv )
import Module ( Module, ModuleEnv,
moduleName, isModuleInThisPackage,
ModuleName, WhereFrom(..),
...
...
ghc/compiler/rename/RnMonad.lhs
View file @
5f67848a
...
...
@@ -54,10 +54,9 @@ import RdrName ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
)
import Name ( Name, OccName, NamedThing(..), getSrcLoc,
nameOccName,
decode, mkLocalName, mkKnownKeyGlobal,
NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv,
extendNameEnvList
decode, mkLocalName, mkKnownKeyGlobal
)
import Name ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList )
import Module ( Module, ModuleName, ModuleSet, emptyModuleSet )
import NameSet
import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
...
...
ghc/compiler/typecheck/TcClassDcl.lhs
View file @
5f67848a
...
...
@@ -43,9 +43,8 @@ import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
import DataCon ( mkDataCon, notMarkedStrict )
import Id ( Id, idType, idName )
import Module ( Module )
import Name ( Name, NamedThing(..), isFrom,
NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv,
plusNameEnv, nameEnvElts )
import Name ( Name, NamedThing(..), isFrom )
import Name ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, plusNameEnv, nameEnvElts )
import NameSet ( emptyNameSet )
import Outputable
import Type ( Type, ClassContext, mkTyVarTys, mkDictTys, mkClassPred,
...
...
ghc/compiler/typecheck/TcEnv.lhs
View file @
5f67848a
...
...
@@ -60,10 +60,9 @@ import Class ( Class, ClassOpItem, ClassContext )
import Subst ( substTy )
import Name ( Name, OccName, NamedThing(..),
nameOccName, nameModule, getSrcLoc, mkGlobalName,
isLocalName, nameModule_maybe,
NameEnv, lookupNameEnv, nameEnvElts,
extendNameEnvList, emptyNameEnv
isLocalName, nameModule_maybe
)
import Name ( NameEnv, lookupNameEnv, nameEnvElts, extendNameEnvList, emptyNameEnv )
import OccName ( mkDFunOcc, mkDefaultMethodOcc, occNameString )
import HscTypes ( DFunId, TypeEnv, HomeSymbolTable, PackageTypeEnv )
import Module ( Module )
...
...
ghc/compiler/typecheck/TcModule.lhs
View file @
5f67848a
...
...
@@ -43,9 +43,8 @@ import Bag ( isEmptyBag )
import ErrUtils ( printErrorsAndWarnings, dumpIfSet_dyn )
import Id ( idType, idUnfolding )
import Module ( Module )
import Name ( Name, isLocallyDefined,
toRdrName, nameEnvElts, lookupNameEnv,
)
import Name ( Name, isLocallyDefined, toRdrName )
import Name ( nameEnvElts, lookupNameEnv )
import TyCon ( tyConGenInfo )
import Maybes ( thenMaybe )
import Util
...
...
ghc/compiler/typecheck/TcTyClsDecls.lhs
View file @
5f67848a
...
...
@@ -39,9 +39,8 @@ import DataCon ( isNullaryDataCon )
import Var ( varName )
import FiniteMap
import Digraph ( stronglyConnComp, SCC(..) )
import Name ( Name, NamedThing(..), NameEnv, getSrcLoc,
mkNameEnv, lookupNameEnv_NF, isTyVarName
)
import Name ( Name, NamedThing(..), getSrcLoc, isTyVarName )
import Name ( NameEnv, mkNameEnv, lookupNameEnv_NF )
import NameSet
import Outputable
import Maybes ( mapMaybe )
...
...
ghc/compiler/types/PprType.lhs
View file @
5f67848a
...
...
@@ -36,7 +36,7 @@ import Class ( Class )
-- others:
import Maybes ( maybeToBool )
import Name ( getOccString )
import Name ( getOccString
, getOccName
)
import Outputable
import PprEnv
import Unique ( Uniquable(..) )
...
...
@@ -121,11 +121,10 @@ ppr_ty env ctxt_prec ty@(TyConApp tycon tys)
-- type constructor (must be Boxed, Unboxed, AnyBox)
-- Otherwise print as (Type x)
case ty1 of
TyConApp bx [] -> ppr
bx
TyConApp bx [] -> ppr
(getOccName bx) -- Always unqualified
other -> maybeParen ctxt_prec tYCON_PREC
(sep [ppr tycon, nest 4 tys_w_spaces])
-- TUPLE CASE (boxed and unboxed)
| isTupleTyCon tycon
&& length tys == tyConArity tycon -- no magic if partially applied
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment