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,322
Issues
4,322
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
362
Merge Requests
362
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
1b471823
Commit
1b471823
authored
Dec 20, 2000
by
simonpj
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[project @ 2000-12-20 11:02:17 by simonpj]
Add comments and tidy
parent
1ecd776e
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
122 additions
and
33 deletions
+122
-33
ghc/compiler/hsSyn/HsBinds.lhs
ghc/compiler/hsSyn/HsBinds.lhs
+2
-5
ghc/compiler/hsSyn/HsDecls.lhs
ghc/compiler/hsSyn/HsDecls.lhs
+102
-14
ghc/compiler/parser/RdrHsSyn.lhs
ghc/compiler/parser/RdrHsSyn.lhs
+2
-0
ghc/compiler/rename/RnHiFiles.lhs
ghc/compiler/rename/RnHiFiles.lhs
+3
-0
ghc/compiler/rename/RnHsSyn.lhs
ghc/compiler/rename/RnHsSyn.lhs
+2
-0
ghc/compiler/rename/RnSource.lhs
ghc/compiler/rename/RnSource.lhs
+11
-14
No files found.
ghc/compiler/hsSyn/HsBinds.lhs
View file @
1b471823
...
...
@@ -241,11 +241,8 @@ data Sig name
SrcLoc
| ClassOpSig name -- Selector name
(DefMeth name) -- (Just dm_name) for source-file class signatures
-- The name may not be used, if there isn't a
-- generic default method, but it's there if we
-- need it
-- Gives DefMeth info for interface files sigs
(DefMeth name) -- Default-method info
-- See "THE NAMING STORY" in HsDecls
(HsType name)
SrcLoc
...
...
ghc/compiler/hsSyn/HsDecls.lhs
View file @
1b471823
...
...
@@ -116,10 +116,15 @@ instance (NamedThing name, Outputable name, Outputable pat)
%* *
%************************************************************************
Type and class declarations carry 'implicit names'. In particular:
--------------------------------
THE NAMING STORY
--------------------------------
Type A.
~~~~~~~
Here is the story about the implicit names that go with type, class, and instance
decls. It's a bit tricky, so pay attention!
"Implicit" (or "system") binders
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Each data type decl defines
a worker name for each constructor
to-T and from-T convertors
...
...
@@ -138,25 +143,108 @@ relevant type or class decl.
Plan of attack:
- Make up their occurrence names immediately
This is done in RdrHsSyn.mkClassDecl, mkTyDecl, mkConDecl
- Ensure they "point to" the parent data/class decl
when loading that decl from an interface file
(See RnHiFiles.getTyClDeclSysNames)
- When renaming the decl look them up in the name cache,
ensure correct module and provenance is set
Type B: Default methods and dictionary functions
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have their own binding in an interface file.
Default methods : occurrence name is derived uniquely from the class decl.
Dict functions : occurrence name is derived from the instance decl, plus a unique number.
Default methods
~~~~~~~~~~~~~~~
- Occurrence name is derived uniquely from the method name
E.g. $dmmax
- If there is a default method name at all, it's recorded in
the ClassOpSig (in HsBinds), in the DefMeth field.
(DefMeth is defined in Class.lhs)
Source-code class decls and interface-code class decls are treated subtly
differently, which has given me a great deal of confusion over the years.
Here's the deal. (We distinguish the two cases because source-code decls
have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
In *source-code* class declarations:
- When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
This is done by RdrHsSyn.mkClassOpSigDM
- The renamer renames it to a Name
- During typechecking, we generate a binding for each $dm for
which there's a programmer-supplied default method:
class Foo a where
op1 :: <type>
op2 :: <type>
op1 = ...
We generate a binding for $dmop1 but not for $dmop2.
The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
The Name for $dmop2 is simply discarded.
In *interface-file* class declarations:
- When parsing, we see if there's an explicit programmer-supplied default method
because there's an '=' sign to indicate it:
class Foo a where
op1 = :: <type> -- NB the '='
op2 :: <type>
We use this info to generate a DefMeth with a suitable RdrName for op1,
and a NoDefMeth for op2
- The interface file has a separate definition for $dmop1, with unfolding etc.
- The renamer renames it to a Name.
- The renamer treats $dmop1 as a free variable of the declaration, so that
the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
This doesn't happen for source code class decls, because they *bind* the default method.
Dictionary functions
~~~~~~~~~~~~~~~~~~~~
Each instance declaration gives rise to one dictionary function binding.
The type checker makes up new source-code instance declarations
(e.g. from 'deriving' or generic default methods --- see
TcInstDcls.tcInstDecls1). So we can't generate the names for
dictionary functions in advance (we don't know how many we need).
On the other hand for interface-file instance declarations, the decl
specifies the name of the dictionary function, and it has a binding elsewhere
in the interface file:
instance {Eq Int} = dEqInt
dEqInt :: {Eq Int} <pragma info>
So again we treat source code and interface file code slightly differently.
Source code:
- Source code instance decls have a Nothing in the (Maybe name) field
(see data InstDecl below)
- The typechecker makes up a Local name for the dict fun for any source-code
instance decl, whether it comes from a source-code instance decl, or whether
the instance decl is derived from some other construct (e.g. 'deriving').
- The occurrence name it chooses is derived from the instance decl (just for
documentation really) --- e.g. dNumInt. Two dict funs may share a common
occurrence name, but will have different uniques. E.g.
instance Foo [Int] where ...
instance Foo [Bool] where ...
These might both be dFooList
- The CoreTidy phase globalises the name, and ensures the occurrence name is
unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
- We can take this relaxed approach (changing the occurrence name later)
because dict fun Ids are not captured in a TyCon or Class (unlike default
methods, say). Instead, they are kept separately in the InstEnv. This
makes it easy to adjust them after compiling a module. (Once we've finished
compiling that module, they don't change any more.)
Interface file code:
- The instance decl gives the dict fun name, so the InstDecl has a (Just name)
in the (Maybe name) field.
- RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
suck in the dfun binding
Plan of attack:
- Do *not* make them point to the parent class decl
- Interface-file decls: treat just like Type A
- Source-file decls: the names aren't in the decl at all;
instead the typechecker makes them up
\begin{code}
data TyClDecl name pat
...
...
ghc/compiler/parser/RdrHsSyn.lhs
View file @
1b471823
...
...
@@ -208,6 +208,8 @@ name of the class itself. This saves recording the names in the interface
file (which would be equally good).
Similarly for mkConDecl, mkClassOpSig and default-method names.
*** See "THE NAMING STORY" in HsDecls ****
\begin{code}
mkClassDecl cxt cname tyvars fds sigs mbinds loc
...
...
ghc/compiler/rename/RnHiFiles.lhs
View file @
1b471823
...
...
@@ -432,6 +432,9 @@ It's used for both source code (from @availsFromDecl@) and interface files
It doesn't deal with source-code specific things: @ValD@, @DefD@. They
are handled by the sourc-code specific stuff in @RnNames@.
*** See "THE NAMING STORY" in HsDecls ****
\begin{code}
getTyClDeclBinders
:: Module
...
...
ghc/compiler/rename/RnHsSyn.lhs
View file @
1b471823
...
...
@@ -117,6 +117,8 @@ In all cases this is set up for interface-file declarations:
- for instance decls likewise, plus the pragmas
- for rule decls, we ignore HsRules
*** See "THE NAMING STORY" in HsDecls ****
\begin{code}
tyClDeclFVs :: RenamedTyClDecl -> NameSet
tyClDeclFVs (IfaceSig {tcdType = ty, tcdIdInfo = id_infos})
...
...
ghc/compiler/rename/RnSource.lhs
View file @
1b471823
...
...
@@ -48,6 +48,7 @@ import SrcLoc ( SrcLoc )
import CmdLineOpts ( DynFlag(..) )
-- Warn of unused for-all'd tyvars
import Unique ( Uniquable(..) )
import Maybes ( maybeToBool )
import ErrUtils ( Message )
import CStrings ( isCLabelString )
import ListSetOps ( removeDupsEq )
...
...
@@ -71,7 +72,7 @@ Checks the @(..)@ etc constraints in the export list.
%*********************************************************
%* *
\subsection{
Valu
e declarations}
\subsection{
Source cod
e declarations}
%* *
%*********************************************************
...
...
@@ -90,17 +91,8 @@ rnSourceDecls gbl_env local_fixity_env decls
go fvs ds' (DeprecD _:ds) = go fvs ds' ds
go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
go (fvs `plusFV` fvs') (d':ds') ds
\end{code}
%*********************************************************
%* *
\subsection{Value declarations}
%* *
%*********************************************************
\begin{code}
-- rnSourceDecl does all the work
rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
...
...
@@ -164,6 +156,7 @@ rnSourceDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
\begin{code}
rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
-- Used for both source and interface file decls
= pushSrcLocRn src_loc $
rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
...
...
@@ -177,9 +170,11 @@ rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
-- Compare rnClassBinds
rnInstBinds (InstDecl _ mbinds uprags _ _ )
(InstDecl inst_ty _ _ maybe_dfun_rdr_name src_loc)
= let
rnInstBinds (InstDecl _ mbinds uprags _ _ )
(InstDecl inst_ty _ _ maybe_dfun_name src_loc)
-- Used for both source decls only
= ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
let
meth_doc = text "the bindings in an instance declaration"
meth_names = collectLocatedMonoBinders mbinds
inst_tyvars = case inst_ty of
...
...
@@ -210,7 +205,7 @@ rnInstBinds (InstDecl _ mbinds uprags _ _ )
renameSigsFVs (okInstDclSig binder_set) uprags
) `thenRn` \ (uprags', prag_fvs) ->
returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_
rdr_
name src_loc,
returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
meth_fvs `plusFV` prag_fvs)
\end{code}
...
...
@@ -326,6 +321,7 @@ rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLo
rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
tcdSysNames = names, tcdLoc = src_loc})
-- Used for both source and interface file decls
= pushSrcLocRn src_loc $
lookupTopBndrRn cname `thenRn` \ cname' ->
...
...
@@ -395,6 +391,7 @@ rnClassOp clas clas_tyvars clas_fds sig@(ClassOpSig op dm_stuff ty locn)
returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
-- Used for source file decls only
rnClassBinds (ClassDecl {tcdMeths = Just mbinds}) -- Get mbinds from here
rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc}) -- Everything else is here
-- There are some default-method bindings (abeit possibly empty) so
...
...
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