[commit: ghc] master: Refactor freeNamesIfDecl (d06cb96)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d06cb9633ec887f7575007dec66dec3a5736dbeb/ghc

>---------------------------------------------------------------

commit d06cb9633ec887f7575007dec66dec3a5736dbeb
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri May 19 11:57:21 2017 +0100

    Refactor freeNamesIfDecl
    
    This just switches to using pattern matching rather than field
    selectors, which I generally prefer.  No change in behaviour.


>---------------------------------------------------------------

d06cb9633ec887f7575007dec66dec3a5736dbeb
 compiler/iface/IfaceSyn.hs | 112 +++++++++++++++++++++++++++------------------
 1 file changed, 68 insertions(+), 44 deletions(-)

diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index aadb7b5..d5ca24e 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -1261,44 +1261,65 @@ fingerprinting the instance, so DFuns are not dependencies.
 -}
 
 freeNamesIfDecl :: IfaceDecl -> NameSet
-freeNamesIfDecl (IfaceId _s t d i) =
-  freeNamesIfType t &&&
-  freeNamesIfIdInfo i &&&
-  freeNamesIfIdDetails d
-freeNamesIfDecl d at IfaceData{} =
-  freeNamesIfTyVarBndrs (ifBinders d) &&&
-  freeNamesIfType (ifResKind d) &&&
-  freeNamesIfaceTyConParent (ifParent d) &&&
-  freeNamesIfContext (ifCtxt d) &&&
-  freeNamesIfConDecls (ifCons d)
-freeNamesIfDecl d at IfaceSynonym{} =
-  freeNamesIfType (ifSynRhs d) &&&
-  freeNamesIfTyVarBndrs (ifBinders d) &&&
-  freeNamesIfKind (ifResKind d)
-freeNamesIfDecl d at IfaceFamily{} =
-  freeNamesIfFamFlav (ifFamFlav d) &&&
-  freeNamesIfTyVarBndrs (ifBinders d) &&&
-  freeNamesIfKind (ifResKind d)
-freeNamesIfDecl d at IfaceClass{ ifBody = IfAbstractClass } =
-  freeNamesIfTyVarBndrs (ifBinders d)
-freeNamesIfDecl d at IfaceClass{ ifBody = d'@IfConcreteClass{} } =
-  freeNamesIfTyVarBndrs (ifBinders d) &&&
-  freeNamesIfContext (ifClassCtxt d') &&&
-  fnList freeNamesIfAT     (ifATs d') &&&
-  fnList freeNamesIfClsSig (ifSigs d')
-freeNamesIfDecl d at IfaceAxiom{} =
-  freeNamesIfTc (ifTyCon d) &&&
-  fnList freeNamesIfAxBranch (ifAxBranches d)
-freeNamesIfDecl d at IfacePatSyn{} =
-  unitNameSet (fst (ifPatMatcher d)) &&&
-  maybe emptyNameSet (unitNameSet . fst) (ifPatBuilder d) &&&
-  freeNamesIfTyVarBndrs (ifPatUnivBndrs d) &&&
-  freeNamesIfTyVarBndrs (ifPatExBndrs d) &&&
-  freeNamesIfContext (ifPatProvCtxt d) &&&
-  freeNamesIfContext (ifPatReqCtxt d) &&&
-  fnList freeNamesIfType (ifPatArgs d) &&&
-  freeNamesIfType (ifPatTy d) &&&
-  mkNameSet (map flSelector (ifFieldLabels d))
+freeNamesIfDecl (IfaceId { ifType = t, ifIdDetails = d, ifIdInfo = i})
+  = freeNamesIfType t &&&
+    freeNamesIfIdInfo i &&&
+    freeNamesIfIdDetails d
+
+freeNamesIfDecl (IfaceData { ifBinders = bndrs, ifResKind = res_k
+                           , ifParent = p, ifCtxt = ctxt, ifCons = cons })
+  = freeNamesIfTyVarBndrs bndrs &&&
+    freeNamesIfType res_k &&&
+    freeNamesIfaceTyConParent p &&&
+    freeNamesIfContext ctxt &&&
+    freeNamesIfConDecls cons
+
+freeNamesIfDecl (IfaceSynonym { ifBinders = bndrs, ifResKind = res_k
+                              , ifSynRhs = rhs })
+  = freeNamesIfTyVarBndrs bndrs &&&
+    freeNamesIfKind res_k &&&
+    freeNamesIfType rhs
+
+freeNamesIfDecl (IfaceFamily { ifBinders = bndrs, ifResKind = res_k
+                             , ifFamFlav = flav })
+  = freeNamesIfTyVarBndrs bndrs &&&
+    freeNamesIfKind res_k &&&
+    freeNamesIfFamFlav flav
+
+freeNamesIfDecl (IfaceClass{ ifBinders = bndrs, ifBody = cls_body })
+  = freeNamesIfTyVarBndrs bndrs &&&
+    freeNamesIfClassBody cls_body
+
+freeNamesIfDecl (IfaceAxiom { ifTyCon = tc, ifAxBranches = branches })
+  = freeNamesIfTc tc &&&
+    fnList freeNamesIfAxBranch branches
+
+freeNamesIfDecl (IfacePatSyn { ifPatMatcher = (matcher, _)
+                             , ifPatBuilder = mb_builder
+                             , ifPatUnivBndrs = univ_bndrs
+                             , ifPatExBndrs = ex_bndrs
+                             , ifPatProvCtxt = prov_ctxt
+                             , ifPatReqCtxt = req_ctxt
+                             , ifPatArgs = args
+                             , ifPatTy = pat_ty
+                             , ifFieldLabels = lbls })
+  = unitNameSet matcher &&&
+    maybe emptyNameSet (unitNameSet . fst) mb_builder &&&
+    freeNamesIfTyVarBndrs univ_bndrs &&&
+    freeNamesIfTyVarBndrs ex_bndrs &&&
+    freeNamesIfContext prov_ctxt &&&
+    freeNamesIfContext req_ctxt &&&
+    fnList freeNamesIfType args &&&
+    freeNamesIfType pat_ty &&&
+    mkNameSet (map flSelector lbls)
+
+freeNamesIfClassBody :: IfaceClassBody -> NameSet
+freeNamesIfClassBody IfAbstractClass
+  = emptyNameSet
+freeNamesIfClassBody (IfConcreteClass{ ifClassCtxt = ctxt, ifATs = ats, ifSigs = sigs })
+  = freeNamesIfContext ctxt  &&&
+    fnList freeNamesIfAT ats &&&
+    fnList freeNamesIfClsSig sigs
 
 freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
 freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars   = tyvars
@@ -1348,12 +1369,15 @@ freeNamesIfConDecls (IfNewTyCon  c) = freeNamesIfConDecl c
 freeNamesIfConDecls _                   = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
-freeNamesIfConDecl c
-  = freeNamesIfTyVarBndrs (ifConExTvs c) &&&
-    freeNamesIfContext (ifConCtxt c) &&&
-    fnList freeNamesIfType (ifConArgTys c) &&&
-    mkNameSet (map flSelector (ifConFields c)) &&&
-    fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
+freeNamesIfConDecl (IfCon { ifConExTvs   = ex_tvs, ifConCtxt = ctxt
+                          , ifConArgTys  = arg_tys
+                          , ifConFields  = flds
+                          , ifConEqSpec  = eq_spec })
+  = freeNamesIfTyVarBndrs ex_tvs &&&
+    freeNamesIfContext ctxt &&&
+    fnList freeNamesIfType arg_tys &&&
+    mkNameSet (map flSelector flds) &&&
+    fnList freeNamesIfType (map snd eq_spec) -- equality constraints
 
 freeNamesIfKind :: IfaceType -> NameSet
 freeNamesIfKind = freeNamesIfType