Commit 991a868b authored by simonpj's avatar simonpj
Browse files

[project @ 2001-09-07 12:44:30 by simonpj]

----------------------------------------
	Make dict funs and default methods
	into LocalIds only at their binding site
	----------------------------------------
        [part of 3 related commits]

There's a long comment about this with MkId.mkDefaultMethodId,
which I reproduce below.

While I was at it, I renamed setIdNoDiscard to setIdLocalExported.
Which is hardly an improvement, I'm afraid.  This renaming touches
	Var.lhs, Id.lhs, SimplCore.lhs
in a trivial way.

	---------------------

Dict funs and default methods are *not* ImplicitIds.  Their definition
involves user-written code, so we can't figure out their strictness etc
based on fixed info, as we can for constructors and record selectors (say).

We build them as GlobalIds, but when in the module where they are
bound, we turn the Id at the *binding site* into an exported LocalId.
This ensures that they are taken to account by free-variable finding
and dependency analysis (e.g. CoreFVs.exprFreeVars).   The simplifier
will propagate the LocalId to all occurrence sites.

Why shouldn't they be bound as GlobalIds?  Because, in particular, if
they are globals, the specialiser floats dict uses above their defns,
which prevents good simplifications happening.  Also the strictness
analyser treats a occurrence of a GlobalId as imported and assumes it
contains strictness in its IdInfo, which isn't true if the thing is
bound in the same module as the occurrence.

It's OK for dfuns to be LocalIds, because we form the instance-env to
pass on to the next module (md_insts) in CoreTidy, afer tidying
and globalising the top-level Ids.

BUT make sure they are *exported* LocalIds (setIdLocalExported) so
that they aren't discarded by the occurrence analyser.
parent 66a9fc6c
......@@ -19,7 +19,7 @@ module Id (
recordSelectorFieldLabel,
-- Modifying an Id
setIdName, setIdUnique, setIdType, setIdNoDiscard, setGlobalIdDetails,
setIdName, setIdUnique, setIdType, setIdLocalExported, setGlobalIdDetails,
setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
zapLamIdInfo, zapDemandIdInfo,
......@@ -79,7 +79,7 @@ import BasicTypes ( Arity )
import Var ( Id, DictId,
isId, isExportedId, isSpecPragmaId, isLocalId,
idName, idType, idUnique, idInfo, isGlobalId,
setIdName, setVarType, setIdUnique, setIdNoDiscard,
setIdName, setVarType, setIdUnique, setIdLocalExported,
setIdInfo, lazySetIdInfo, modifyIdInfo,
maybeModifyIdInfo,
globalIdDetails, setGlobalIdDetails
......
......@@ -21,7 +21,7 @@ module Var (
Id, DictId,
idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
setIdName, setIdUnique, setIdInfo, lazySetIdInfo,
setIdNoDiscard, zapSpecPragmaId,
setIdLocalExported, zapSpecPragmaId,
globalIdDetails, setGlobalIdDetails,
......@@ -41,7 +41,7 @@ import {-# SOURCE #-} IdInfo( GlobalIdDetails, notGlobalId,
import Name ( Name, OccName, NamedThing(..),
setNameUnique, setNameOcc, nameUnique,
mkSysLocalName, isExternallyVisibleName
mkSysLocalName
)
import Unique ( Unique, Uniquable(..), mkUniqueGrimily, getKey )
import FastTypes
......@@ -253,10 +253,8 @@ setIdUnique = setVarUnique
setIdName :: Id -> Name -> Id
setIdName = setVarName
setIdNoDiscard :: Id -> Id
setIdNoDiscard id
= WARN( not (isLocalId id), ppr id )
id { varDetails = LocalId Exported }
setIdLocalExported :: Id -> Id
setIdLocalExported id = id { varDetails = LocalId Exported }
zapSpecPragmaId :: Id -> Id
zapSpecPragmaId id
......
......@@ -32,7 +32,7 @@ import SimplMonad
import ErrUtils ( dumpIfSet, dumpIfSet_dyn )
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
import Id ( idName, isDataConWrapId, setIdNoDiscard, isImplicitId )
import Id ( idName, isDataConWrapId, setIdLocalExported, isImplicitId )
import VarSet
import LiberateCase ( liberateCase )
import SAT ( doStaticArgs )
......@@ -285,9 +285,9 @@ updateBinders rule_ids rule_rhs_fvs is_exported binds
update_bndr bndr
| isImplicitId bndr = bndr -- Constructors, selectors; doesn't
-- make sense to call setIdNoDiscard
-- make sense to call setIdLocalExported
-- Also can't have rules
| dont_discard bndr = setIdNoDiscard bndr_with_rules
| dont_discard bndr = setIdLocalExported bndr_with_rules
| otherwise = bndr_with_rules
where
bndr_with_rules = lookupVarSet rule_ids bndr `orElse` bndr
......
......@@ -43,7 +43,7 @@ import Class ( classTyVars, classBigSig, classTyCon, className,
Class, ClassOpItem, DefMeth (..) )
import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
import DataCon ( mkDataCon )
import Id ( idType, idName )
import Id ( idType, idName, setIdLocalExported )
import Module ( Module )
import Name ( Name, NamedThing(..) )
import NameEnv ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, plusNameEnv )
......@@ -201,7 +201,8 @@ checkDefaultBinds clas ops (Just mbs)
tcClassSig :: RecTcEnv -- Knot tying only!
-> Class -- ...ditto...
-> [TyVar] -- The class type variable, used for error check only
-> Maybe (NameEnv Bool) -- Info about default methods
-> Maybe (NameEnv Bool) -- Info about default methods;
-- Nothing => imported class defn with no method binds
-> RenamedClassOpSig
-> TcM (Type, -- Type of the method
ClassOpItem) -- Selector Id, default-method Id, True if explicit default binding
......@@ -423,6 +424,8 @@ tcDefMeth clas tyvars binds_in prags op_item@(_, DefMeth dm_id)
= tcInstTyVars tyvars `thenNF_Tc` \ (clas_tyvars, inst_tys, _) ->
let
theta = [(mkClassPred clas inst_tys)]
local_dm_id = setIdLocalExported dm_id
-- Reason for setIdLocalExported: see notes with MkId.mkDictFunId
in
newDicts origin theta `thenNF_Tc` \ [this_dict] ->
......@@ -447,7 +450,7 @@ tcDefMeth clas tyvars binds_in prags op_item@(_, DefMeth dm_id)
full_bind = AbsBinds
clas_tyvars'
[instToId this_dict]
[(clas_tyvars', dm_id, instToId local_dm_inst)]
[(clas_tyvars', local_dm_id, instToId local_dm_inst)]
emptyNameSet -- No inlines (yet)
(dict_binds `andMonoBinds` defm_bind)
in
......
......@@ -52,6 +52,7 @@ import DataCon ( classDataCon )
import Class ( Class, DefMeth(..), classBigSig )
import Var ( idName, idType )
import VarSet ( emptyVarSet )
import Id ( setIdLocalExported )
import MkId ( mkDictFunId )
import FunDeps ( checkInstFDs )
import Generics ( validGenericInstanceType )
......@@ -329,7 +330,7 @@ get_generics decl@(ClassDecl {tcdName = class_name, tcdMeths = Just def_methods,
| null groups
= returnTc [] -- The comon case: no generic default methods
| otherwise -- A local class decl with generic default methods
| otherwise -- A source class decl with generic default methods
= recoverNF_Tc (returnNF_Tc []) $
tcAddDeclCtxt decl $
tcLookupClass class_name `thenTc` \ clas ->
......@@ -603,6 +604,9 @@ tcInstDecl2 (InstInfo { iDFunId = dfun_id,
-- Create the result bindings
let
local_dfun_id = setIdLocalExported dfun_id
-- Reason for setIdLocalExported: see notes with MkId.mkDictFunId
dict_constr = classDataCon clas
scs_and_meths = map instToId (sc_dicts ++ meth_insts)
this_dict_id = instToId this_dict
......
Markdown is supported
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