Commit 741f837d authored by niteria's avatar niteria Committed by Bartosz Nitka
Browse files

Implement more deterministic operations and document them

I will need them for the future determinism fixes.

Test Plan: ./validate

Reviewers: simonpj, goldfire, bgamari, austin, hvr, simonmar

Reviewed By: simonpj, simonmar

Subscribers: osa1, thomie

Differential Revision: https://phabricator.haskell.org/D1537

GHC Trac Issues: #4012
parent 218fdf92
......@@ -26,13 +26,15 @@ module VarSet (
-- ** Manipulating these sets
emptyDVarSet, unitDVarSet, mkDVarSet,
extendDVarSet,
extendDVarSet, extendDVarSetList,
elemDVarSet, dVarSetElems, subDVarSet,
unionDVarSet, unionDVarSets, mapUnionDVarSet,
intersectDVarSet,
isEmptyDVarSet, delDVarSet,
intersectDVarSet, intersectsDVarSet, disjointDVarSet,
isEmptyDVarSet, delDVarSet, delDVarSetList,
minusDVarSet, foldDVarSet, filterDVarSet,
transCloDVarSet,
sizeDVarSet, seqDVarSet,
partitionDVarSet,
) where
#include "HsVersions.h"
......@@ -42,15 +44,13 @@ import Unique
import UniqSet
import UniqDSet
import UniqFM( disjointUFM )
import UniqDFM( disjointUDFM )
{-
************************************************************************
* *
\subsection{@VarSet@s}
* *
************************************************************************
-}
-- | A non-deterministic set of variables.
-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not
-- deterministic and why it matters. Use DVarSet if the set eventually
-- gets converted into a list or folded over in a way where the order
-- changes the generated code, for example when abstracting variables.
type VarSet = UniqSet Var
type IdSet = UniqSet Id
type TyVarSet = UniqSet TyVar
......@@ -206,6 +206,14 @@ mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs
intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
intersectDVarSet = intersectUniqDSets
-- | True if empty intersection
disjointDVarSet :: DVarSet -> DVarSet -> Bool
disjointDVarSet s1 s2 = disjointUDFM s1 s2
-- | True if non-empty intersection
intersectsDVarSet :: DVarSet -> DVarSet -> Bool
intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)
isEmptyDVarSet :: DVarSet -> Bool
isEmptyDVarSet = isEmptyUniqDSet
......@@ -224,5 +232,43 @@ filterDVarSet = filterUniqDSet
sizeDVarSet :: DVarSet -> Int
sizeDVarSet = sizeUniqDSet
-- | Partition DVarSet according to the predicate given
partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
partitionDVarSet = partitionUniqDSet
-- | Delete a list of variables from DVarSet
delDVarSetList :: DVarSet -> [Var] -> DVarSet
delDVarSetList = delListFromUniqDSet
seqDVarSet :: DVarSet -> ()
seqDVarSet s = sizeDVarSet s `seq` ()
-- | Add a list of variables to DVarSet
extendDVarSetList :: DVarSet -> [Var] -> DVarSet
extendDVarSetList = addListToUniqDSet
-- | transCloVarSet for DVarSet
transCloDVarSet :: (DVarSet -> DVarSet)
-- Map some variables in the set to
-- extra variables that should be in it
-> DVarSet -> DVarSet
-- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
-- new variables to s that it finds thereby, until it reaches a fixed point.
--
-- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
-- for efficiency, so that the test can be batched up.
-- It's essential that fn will work fine if given new candidates
-- one at at time; ie fn {v1,v2} = fn v1 `union` fn v2
transCloDVarSet fn seeds
= go seeds seeds
where
go :: DVarSet -- Accumulating result
-> DVarSet -- Work-list; un-processed subset of accumulating result
-> DVarSet
-- Specification: go acc vs = acc `union` transClo fn vs
go acc candidates
| isEmptyDVarSet new_vs = acc
| otherwise = go (acc `unionDVarSet` new_vs) new_vs
where
new_vs = fn candidates `minusDVarSet` acc
......@@ -10,11 +10,12 @@ Taken quite directly from the Peyton Jones/Lester paper.
-- | A module concerned with finding the free variables of an expression.
module CoreFVs (
-- * Free variables of expressions and binding groups
exprFreeVars, -- CoreExpr -> VarSet -- Find all locally-defined free Ids or tyvars
exprFreeDVars, -- CoreExpr -> DVarSet -- Find all locally-defined free Ids or tyvars
exprFreeIds, -- CoreExpr -> IdSet -- Find all locally-defined free Ids
exprsFreeVars, -- [CoreExpr] -> VarSet
bindFreeVars, -- CoreBind -> VarSet
exprFreeVars,
exprFreeVarsDSet,
exprFreeIds,
exprsFreeVars,
exprsFreeVarsList,
bindFreeVars,
-- * Selective free variables of expressions
InterestingVarFun,
......@@ -27,7 +28,7 @@ module CoreFVs (
idFreeVarsAcc,
idRuleVars, idRuleRhsVars, stableUnfoldingVars,
ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,
rulesFreeDVars,
rulesFreeVarsDSet,
ruleLhsFreeIds, exprsOrphNames,
vectsFreeVars,
......@@ -51,7 +52,6 @@ import Name
import VarSet
import Var
import TcType
import TypeRep
import Coercion
import Maybes( orElse )
import Util
......@@ -76,27 +76,47 @@ but not those that are free in the type of variable occurrence.
-}
-- | Find all locally-defined free Ids or type variables in an expression
-- returning a non-deterministic set.
exprFreeVars :: CoreExpr -> VarSet
exprFreeVars = runFVSet . filterFV isLocalVar . expr_fvs
exprFreeVars = runFVSet . exprFreeVarsAcc
exprFreeDVars :: CoreExpr -> DVarSet
exprFreeDVars = runFVDSet . filterFV isLocalVar . expr_fvs
-- | Find all locally-defined free Ids or type variables in an expression
-- returning a composable FV computation. See Note [FV naming coventions] in FV
-- for why export it.
exprFreeVarsAcc :: CoreExpr -> FV
exprFreeVarsAcc = filterFV isLocalVar . expr_fvs
-- | Find all locally-defined free Ids or type variables in an expression
-- returning a deterministic set.
exprFreeVarsDSet :: CoreExpr -> DVarSet
exprFreeVarsDSet = runFVDSet . exprFreeVarsAcc
-- | Find all locally-defined free Ids in an expression
exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids
exprFreeIds = exprSomeFreeVars isLocalId
-- | Find all locally-defined free Ids or type variables in several expressions
-- returning a non-deterministic set.
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = mapUnionVarSet exprFreeVars
exprsFreeVars = runFVSet . exprsFreeVarsAcc
-- | Find all locally-defined free Ids or type variables in several expressions
-- returning a composable FV computation. See Note [FV naming coventions] in FV
-- for why export it.
exprsFreeVarsAcc :: [CoreExpr] -> FV
exprsFreeVarsAcc exprs = mapUnionFV exprFreeVarsAcc exprs
-- | Find all locally-defined free Ids or type variables in several expressions
-- returning a deterministically ordered list.
exprsFreeVarsList :: [CoreExpr] -> [Var]
exprsFreeVarsList = runFVList . exprsFreeVarsAcc
-- | Find all locally defined free Ids in a binding group
bindFreeVars :: CoreBind -> VarSet
bindFreeVars (NonRec b r) = runFVSet $ filterFV isLocalVar $ rhs_fvs (b,r)
bindFreeVars (Rec prs) = runFVSet $ filterFV isLocalVar $
addBndrs (map fst prs)
(foldr (unionFV . rhs_fvs) noVars prs)
(mapUnionFV rhs_fvs prs)
-- | Finds free variables in an expression selected by a predicate
exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting
......@@ -109,7 +129,7 @@ exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting
-> [CoreExpr]
-> VarSet
exprsSomeFreeVars fv_cand es =
runFVSet $ filterFV fv_cand $ foldr (unionFV . expr_fvs) noVars es
runFVSet $ filterFV fv_cand $ mapUnionFV expr_fvs es
-- Comment about obselete code
-- We used to gather the free variables the RULES at a variable occurrence
......@@ -139,11 +159,6 @@ exprsSomeFreeVars fv_cand es =
-- | otherwise = set
-- SLPJ Feb06
-- XXX move to FV
someVars :: [Var] -> FV
someVars vars = foldr (unionFV . oneVar) noVars vars
addBndr :: CoreBndr -> FV -> FV
addBndr bndr fv fv_cand in_scope acc
= (varTypeTyVarsAcc bndr `unionFV`
......@@ -155,7 +170,6 @@ addBndrs :: [CoreBndr] -> FV -> FV
addBndrs bndrs fv = foldr addBndr fv bndrs
expr_fvs :: CoreExpr -> FV
expr_fvs (Type ty) fv_cand in_scope acc =
tyVarsOfTypeAcc ty fv_cand in_scope acc
expr_fvs (Coercion co) fv_cand in_scope acc =
......@@ -173,7 +187,7 @@ expr_fvs (Cast expr co) fv_cand in_scope acc =
expr_fvs (Case scrut bndr ty alts) fv_cand in_scope acc
= (expr_fvs scrut `unionFV` tyVarsOfTypeAcc ty `unionFV` addBndr bndr
(foldr (unionFV . alt_fvs) noVars alts)) fv_cand in_scope acc
(mapUnionFV alt_fvs alts)) fv_cand in_scope acc
where
alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
......@@ -183,18 +197,18 @@ expr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc
expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc
= addBndrs (map fst pairs)
(foldr (unionFV . rhs_fvs) (expr_fvs body) pairs)
(mapUnionFV rhs_fvs pairs `unionFV` expr_fvs body)
fv_cand in_scope acc
---------
rhs_fvs :: (Id, CoreExpr) -> FV
rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`
bndrRuleAndUnfoldingVarsAcc bndr -- XXX: FIXME
bndrRuleAndUnfoldingVarsAcc bndr
-- Treat any RULES as extra RHSs of the binding
---------
exprs_fvs :: [CoreExpr] -> FV
exprs_fvs exprs = foldr (unionFV . expr_fvs) noVars exprs
exprs_fvs exprs = mapUnionFV expr_fvs exprs
tickish_fvs :: Tickish Id -> FV
tickish_fvs (Breakpoint _ ids) = someVars ids
......@@ -247,7 +261,8 @@ exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es
************************************************************************
-}
-- | Those variables free in the right hand side of a rule
-- | Those variables free in the right hand side of a rule returned as a
-- non-deterministic set
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars (BuiltinRule {}) = noFVs
ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })
......@@ -255,28 +270,29 @@ ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })
-- See Note [Rule free var hack]
-- | Those variables free in the both the left right hand sides of a rule
-- returned as a non-deterministic set
ruleFreeVars :: CoreRule -> VarSet
ruleFreeVars (BuiltinRule {}) = noFVs
ruleFreeVars (Rule { ru_fn = _do_not_include -- See Note [Rule free var hack]
, ru_bndrs = bndrs
, ru_rhs = rhs, ru_args = args })
= runFVSet $ filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))
ruleFreeVars = runFVSet . ruleFreeVarsAcc
-- | Those variables free in the both the left right hand sides of a rule
-- returned as FV computation
ruleFreeVarsAcc :: CoreRule -> FV
ruleFreeVarsAcc (BuiltinRule {}) =
noVars
ruleFreeVarsAcc (Rule { ru_fn = _do_not_include -- See Note [Rule free var hack]
ruleFreeVarsAcc (BuiltinRule {}) = noVars
ruleFreeVarsAcc (Rule { ru_fn = _do_not_include
-- See Note [Rule free var hack]
, ru_bndrs = bndrs
, ru_rhs = rhs, ru_args = args })
= addBndrs bndrs (exprs_fvs (rhs:args))
= filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))
-- | Those variables free in the both the left right hand sides of rules
-- returned as FV computation
rulesFreeVarsAcc :: [CoreRule] -> FV
rulesFreeVarsAcc (rule:rules) = ruleFreeVarsAcc rule `unionFV` rulesFreeVarsAcc rules
rulesFreeVarsAcc [] = noVars
rulesFreeDVars :: [CoreRule] -> DVarSet
rulesFreeDVars rules = runFVDSet $ filterFV isLocalVar $ rulesFreeVarsAcc rules
rulesFreeVarsAcc = mapUnionFV ruleFreeVarsAcc
-- | Those variables free in the both the left right hand sides of rules
-- returned as a deterministic set
rulesFreeVarsDSet :: [CoreRule] -> DVarSet
rulesFreeVarsDSet rules = runFVDSet $ rulesFreeVarsAcc rules
idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
-- Just the variables free on the *rhs* of a rule
......@@ -525,7 +541,7 @@ freeVars (Let (Rec binds) body)
rhss2 = map freeVars rhss
rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
binders_fvs = runFVDSet $ foldr (unionFV . idRuleAndUnfoldingVarsAcc) noVars binders
binders_fvs = runFVDSet $ mapUnionFV idRuleAndUnfoldingVarsAcc binders
all_fvs = rhs_body_fvs `unionFVs` binders_fvs
-- The "delBinderFV" happens after adding the idSpecVars,
-- since the latter may add some of the binders as fvs
......
......@@ -479,7 +479,7 @@ schemeE d s p exp@(AnnTick (Breakpoint _id _fvs) _rhs)
let letExp = AnnLet (AnnNonRec id (fvs, exp)) (emptyDVarSet, AnnVar id)
schemeE d s p letExp
where exp' = deAnnotate' exp
fvs = exprFreeDVars exp'
fvs = exprFreeVarsDSet exp'
ty = exprType exp'
-- ignore other kinds of tick
......
......@@ -771,10 +771,10 @@ lvlBind env (AnnRec pairs)
-- Finding the free vars of the binding group is annoying
bind_fvs = ((unionDVarSets [ rhs_fvs | (_, (rhs_fvs,_)) <- pairs])
`unionDVarSet`
(runFVDSet $ foldr unionFV noVars [ idFreeVarsAcc bndr
| (bndr, (_,_)) <- pairs]))
`minusDVarSet`
mkDVarSet bndrs -- XXX: it's a waste to create a set here
(runFVDSet $ unionsFV [ idFreeVarsAcc bndr
| (bndr, (_,_)) <- pairs]))
`delDVarSetList`
bndrs
dest_lvl = destLevel env bind_fvs (all isFunction rhss) False
abs_vars = abstractVars dest_lvl env bind_fvs
......
......@@ -33,7 +33,7 @@ import Module ( Module, ModuleSet, elemModuleSet )
import CoreSubst
import OccurAnal ( occurAnalyseExpr )
import CoreFVs ( exprFreeVars, exprsFreeVars, bindFreeVars
, rulesFreeDVars, exprsOrphNames )
, rulesFreeVarsDSet, exprsOrphNames )
import CoreUtils ( exprType, eqExpr, mkTick, mkTicks,
stripTicksTopT, stripTicksTopE )
import PprCore ( pprRules )
......@@ -275,11 +275,11 @@ pprRulesForUser rules
-- | Make a 'RuleInfo' containing a number of 'CoreRule's, suitable
-- for putting into an 'IdInfo'
mkRuleInfo :: [CoreRule] -> RuleInfo
mkRuleInfo rules = RuleInfo rules (rulesFreeDVars rules)
mkRuleInfo rules = RuleInfo rules (rulesFreeVarsDSet rules)
extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo
extendRuleInfo (RuleInfo rs1 fvs1) rs2
= RuleInfo (rs2 ++ rs1) (rulesFreeDVars rs2 `unionDVarSet` fvs1)
= RuleInfo (rs2 ++ rs1) (rulesFreeVarsDSet rs2 `unionDVarSet` fvs1)
addRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo
addRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2)
......
......@@ -9,7 +9,7 @@ The @Inst@ type: dictionaries or method instances
{-# LANGUAGE CPP #-}
module Inst (
deeplySkolemise, deeplyInstantiate,
deeplySkolemise, deeplyInstantiate,
instCall, instDFunType, instStupidTheta,
newWanted, newWanteds,
emitWanted, emitWanteds,
......@@ -25,6 +25,7 @@ module Inst (
-- Simple functions over evidence variables
tyVarsOfWC, tyVarsOfBag,
tyVarsOfCt, tyVarsOfCts,
tyVarsOfCtList, tyVarsOfCtsList,
) where
#include "HsVersions.h"
......@@ -60,6 +61,7 @@ import Util
import Outputable
import Control.Monad( unless )
import Data.Maybe( isJust )
import FV
{-
************************************************************************
......@@ -623,16 +625,43 @@ addClsInstsErr herald ispecs
-}
---------------- Getting free tyvars -------------------------
tyVarsOfCt :: Ct -> TcTyVarSet
tyVarsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) = extendVarSet (tyVarsOfType xi) tv
tyVarsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) = extendVarSet (tyVarsOfTypes tys) fsk
tyVarsOfCt (CDictCan { cc_tyargs = tys }) = tyVarsOfTypes tys
tyVarsOfCt (CIrredEvCan { cc_ev = ev }) = tyVarsOfType (ctEvPred ev)
tyVarsOfCt (CHoleCan { cc_ev = ev }) = tyVarsOfType (ctEvPred ev)
tyVarsOfCt (CNonCanonical { cc_ev = ev }) = tyVarsOfType (ctEvPred ev)
-- | Returns free variables of constraints as a non-deterministic set
tyVarsOfCt :: Ct -> TcTyVarSet
tyVarsOfCt = runFVSet . tyVarsOfCtAcc
-- | Returns free variables of constraints as a deterministically ordered.
-- list. See Note [Deterministic FV] in FV.
tyVarsOfCtList :: Ct -> [TcTyVar]
tyVarsOfCtList = runFVList . tyVarsOfCtAcc
-- | Returns free variables of constraints as a composable FV computation.
-- See Note [Deterministic FV] in FV.
tyVarsOfCtAcc :: Ct -> FV
tyVarsOfCtAcc (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })
= tyVarsOfTypeAcc xi `unionFV` oneVar tv
tyVarsOfCtAcc (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk })
= tyVarsOfTypesAcc tys `unionFV` oneVar fsk
tyVarsOfCtAcc (CDictCan { cc_tyargs = tys }) = tyVarsOfTypesAcc tys
tyVarsOfCtAcc (CIrredEvCan { cc_ev = ev }) = tyVarsOfTypeAcc (ctEvPred ev)
tyVarsOfCtAcc (CHoleCan { cc_ev = ev }) = tyVarsOfTypeAcc (ctEvPred ev)
tyVarsOfCtAcc (CNonCanonical { cc_ev = ev }) = tyVarsOfTypeAcc (ctEvPred ev)
-- | Returns free variables of a bag of constraints as a non-deterministic
-- set. See Note [Deterministic FV] in FV.
tyVarsOfCts :: Cts -> TcTyVarSet
tyVarsOfCts = foldrBag (unionVarSet . tyVarsOfCt) emptyVarSet
tyVarsOfCts = runFVSet . tyVarsOfCtsAcc
-- | Returns free variables of a bag of constraints as a deterministically
-- odered list. See Note [Deterministic FV] in FV.
tyVarsOfCtsList :: Cts -> [TcTyVar]
tyVarsOfCtsList = runFVList . tyVarsOfCtsAcc
-- | Returns free variables of a bag of constraints as a composable FV
-- computation. See Note [Deterministic FV] in FV.
tyVarsOfCtsAcc :: Cts -> FV
tyVarsOfCtsAcc = foldrBag (unionFV . tyVarsOfCtAcc) noVars
tyVarsOfWC :: WantedConstraints -> TyVarSet
-- Only called on *zonked* things, hence no need to worry about flatten-skolems
......
......@@ -21,7 +21,7 @@ module TcType (
--------------------------------
-- Types
TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
TcTyVar, TcTyVarSet, TcKind, TcCoVar,
TcTyVar, TcTyVarSet, TcDTyVarSet, TcKind, TcCoVar,
-- TcLevel
TcLevel(..), topTcLevel, pushTcLevel,
......@@ -144,6 +144,8 @@ module TcType (
tyVarsOfType, tyVarsOfTypes, closeOverKinds,
tyVarsOfTypeList, tyVarsOfTypesList,
tyVarsOfTypeAcc, tyVarsOfTypesAcc,
tyVarsOfTypeDSet, tyVarsOfTypesDSet, closeOverKindsDSet,
tcTyVarsOfType, tcTyVarsOfTypes,
pprKind, pprParendKind, pprSigmaType,
......@@ -244,6 +246,7 @@ type TcRhoType = TcType -- Note [TcRhoType]
type TcTauType = TcType
type TcKind = Kind
type TcTyVarSet = TyVarSet
type TcDTyVarSet = DTyVarSet
{-
Note [TcRhoType]
......
......@@ -44,6 +44,8 @@ module TypeRep (
-- Free variables
tyVarsOfType, tyVarsOfTypes, closeOverKinds, varSetElemsKvsFirst,
tyVarsOfTypeAcc, tyVarsOfTypeList, tyVarsOfTypesAcc, tyVarsOfTypesList,
tyVarsOfTypeDSet, tyVarsOfTypesDSet,
closeOverKindsDSet, closeOverKindsAcc,
-- * Tidying type related things up for printing
tidyType, tidyTypes,
......@@ -308,29 +310,49 @@ isKindVar v = isTKVar v && isSuperKind (varType v)
************************************************************************
-}
-- | Returns free variables of a type, including kind variables as
-- a non-deterministic set. For type synonyms it does /not/ expand the
-- synonym.
tyVarsOfType :: Type -> VarSet
-- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
-- tyVarsOfType returns free variables of a type, including kind variables.
tyVarsOfType ty = runFVSet $ tyVarsOfTypeAcc ty
-- | `tyVarsOfType` that returns free variables of a type in deterministic
-- order. For explanation of why using `VarSet` is not deterministic see
-- Note [Deterministic UniqFM] in UniqDFM.
tyVarsOfTypeList :: Type -> [Var]
-- Note [Deterministic FV] in FV.
tyVarsOfTypeList :: Type -> [TyVar]
tyVarsOfTypeList ty = runFVList $ tyVarsOfTypeAcc ty
-- | `tyVarsOfType` that returns free variables of a type in a deterministic
-- set. For explanation of why using `VarSet` is not deterministic see
-- Note [Deterministic FV] in FV.
tyVarsOfTypeDSet :: Type -> DTyVarSet
tyVarsOfTypeDSet ty = runFVDSet $ tyVarsOfTypeAcc ty
-- | Returns free variables of types, including kind variables as
-- a non-deterministic set. For type synonyms it does /not/ expand the
-- synonym.
tyVarsOfTypes :: [Type] -> TyVarSet
tyVarsOfTypes tys = runFVSet $ tyVarsOfTypesAcc tys
tyVarsOfTypesList :: [Type] -> [Var]
-- | Returns free variables of types, including kind variables as
-- a deterministically ordered list. For type synonyms it does /not/ expand the
-- synonym.
tyVarsOfTypesList :: [Type] -> [TyVar]
tyVarsOfTypesList tys = runFVList $ tyVarsOfTypesAcc tys
-- | Returns free variables of types, including kind variables as
-- a deterministic set. For type synonyms it does /not/ expand the
-- synonym.
tyVarsOfTypesDSet :: [Type] -> DTyVarSet
tyVarsOfTypesDSet tys = runFVDSet $ tyVarsOfTypesAcc tys
-- | The worker for `tyVarsOfType` and `tyVarsOfTypeList`.
-- The previous implementation used `unionVarSet` which is O(n+m) and can
-- make the function quadratic.
-- It's exported, so that it can be composed with other functions that compute
-- free variables.
-- See Note [FV naming conventions] in FV.
tyVarsOfTypeAcc :: Type -> FV
tyVarsOfTypeAcc (TyVarTy v) fv_cand in_scope acc = oneVar v fv_cand in_scope acc
tyVarsOfTypeAcc (TyConApp _ tys) fv_cand in_scope acc =
......@@ -349,12 +371,22 @@ tyVarsOfTypesAcc (ty:tys) fv_cand in_scope acc =
(tyVarsOfTypeAcc ty `unionFV` tyVarsOfTypesAcc tys) fv_cand in_scope acc
tyVarsOfTypesAcc [] fv_cand in_scope acc = noVars fv_cand in_scope acc
-- | Add the kind variables free in the kinds of the tyvars in the given set.
-- Returns a non-deterministic set.
closeOverKinds :: TyVarSet -> TyVarSet
-- Add the kind variables free in the kinds
-- of the tyvars in the given set
closeOverKinds tvs
= foldVarSet (\tv ktvs -> tyVarsOfType (tyVarKind tv) `unionVarSet` ktvs)
tvs tvs
closeOverKinds = runFVSet . closeOverKindsAcc . varSetElems
-- | Given a list of tyvars returns a deterministic FV computation that
-- returns the given tyvars with the kind variables free in the kinds of the
-- given tyvars.
closeOverKindsAcc :: [TyVar] -> FV
closeOverKindsAcc tvs =
mapUnionFV (tyVarsOfTypeAcc . tyVarKind) tvs `unionFV` someVars tvs
-- | Add the kind variables free in the kinds of the tyvars in the given set.
-- Returns a deterministic set.
closeOverKindsDSet :: DTyVarSet -> DTyVarSet
closeOverKindsDSet = runFVDSet . closeOverKindsAcc . dVarSetElems
varSetElemsKvsFirst :: VarSet -> [TyVar]
-- {k1,a,k2,b} --> [k1,k2,a,b]
......
......@@ -17,10 +17,13 @@ module FV (
-- ** Manipulating those computations
oneVar,
noVars,
someVars,
unionFV,
unionsFV,
delFV,
delFVs,
filterFV,
mapUnionFV,
) where
import Var
......@@ -30,7 +33,19 @@ import VarSet
-- interesting
type InterestingVarFun = Var -> Bool
-- Note [Deterministic FV]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- When computing free variables, the order in which you get them affects
-- the results of floating and specialization. If you use UniqFM to collect
-- them and then turn that into a list, you get them in nondeterministic
-- order as described in Note [Deterministic UniqFM] in UniqDFM.
-- A naive algorithm for free variables relies on merging sets of variables.
-- Merging costs O(n+m) for UniqFM and for UniqDFM there's an additional log
-- factor. It's cheaper to incrementally add to a list and use a set to check
-- for duplicates.
type FV = InterestingVarFun
-- Used for filtering sets as we build them
-> VarSet
-- Locally bound variables
-> ([Var], VarSet)
......@@ -40,48 +55,144 @@ type FV = InterestingVarFun
-- Note [Deterministic UniqFM] in UniqDFM.
-> ([Var], VarSet)
-- Note [FV naming conventions]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- To get the performance and determinism that FV provides, FV computations
-- need to built up from smaller FV computations and then evaluated with
-- one of `runFVList`, `runFVDSet`, `runFV`. That means the functions
-- returning FV need to be exported.
--
-- The conventions are:
--
-- a) non-deterministic functions:
-- * x - a function that returns VarSet
-- e.g. `tyVarsOfType`
-- b) deterministic functions:
-- * xAcc - a worker that returns FV
-- e.g. `tyVarsOfTypeAcc`
-- * xList - a function that returns [Var]
-- e.g. `tyVarsOfTypeList`
-- * xDSet - a function that returns DVarSet
-- e.g. `tyVarsOfTypeDSet`
--
-- Where x, xList, xDSet are implemented in terms of the worker evaluated with
-- runFVSet, runFVList, runFVDSet respectively.
-- | Run a free variable computation, returning a list of distinct free
-- variables in deterministic order and a non-deterministic set containing
-- those variables.
runFV :: FV -> ([Var], VarSet)
runFV fv = fv (const True) emptyVarSet ([], emptyVarSet)
-- | Run a free variable computation, returning a list of distinct free
-- variables in deterministic order.
runFVList :: FV -> [Var]
runFVList = fst . runFV