Commit 46368868 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve the desugaring of -XStrict

Trac #14035 showed that -XStrict was generating some TERRIBLE
desugarings, espcially for bindings with INLINE pragmas. Reason: with
-XStrict, all AbsBinds (even for non-recursive functions) went via the
general-case deguaring for AbsBinds, namely "generate a tuple and
select from it", even though in this case there was only one variable
in the tuple.  And that in turn interacts terribly badly with INLINE
pragmas.

This patch cleans things up:

* I killed off AbsBindsSig completely, in favour of a boolean flag
  abs_sig in AbsBinds.  See Note [The abs_sig field of AbsBinds]

  This allowed me to delete lots of code; and instance-method
  declarations can enjoy the benefits too.  (They could have
  before, but no one had changed them to use AbsBindsSig.)

* I refactored all the AbsBinds handling in DsBinds into a new
  function DsBinds.dsAbsBinds.  This allowed me to handle the
  strict case uniformly
parent 2535a671
......@@ -281,31 +281,6 @@ addTickLHsBind (L pos bind@(AbsBinds { abs_binds = binds,
| ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
, isInlinePragma (idInlinePragma pid) ] }
addTickLHsBind (L pos bind@(AbsBindsSig { abs_sig_bind = val_bind
, abs_sig_export = poly_id }))
| L _ FunBind { fun_id = L _ mono_id } <- val_bind
= do withEnv (add_export mono_id) $ do
withEnv (add_inlines mono_id) $ do
val_bind' <- addTickLHsBind val_bind
return $ L pos $ bind { abs_sig_bind = val_bind' }
| otherwise
= pprPanic "addTickLHsBind" (ppr bind)
where
-- see AbsBinds comments
add_export mono_id env
| idName poly_id `elemNameSet` exports env
= env { exports = exports env `extendNameSet` idName mono_id }
| otherwise
= env
-- See Note [inline sccs]
add_inlines mono_id env
| isInlinePragma (idInlinePragma poly_id)
= env { inlines = inlines env `extendVarSet` mono_id }
| otherwise
= env
addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
let name = getOccString id
decl_path <- getPathEntry
......
This diff is collapsed.
......@@ -130,8 +130,6 @@ ds_val_bind (NonRecursive, hsbinds) body
where
is_polymorphic (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs })
= not (null tvs && null evs)
is_polymorphic (AbsBindsSig { abs_tvs = tvs, abs_ev_vars = evs })
= not (null tvs && null evs)
is_polymorphic _ = False
unlifted_must_be_bang bind
......@@ -186,15 +184,6 @@ dsUnliftedBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
; ds_binds <- dsTcEvBinds_s ev_binds
; return (mkCoreLets ds_binds body2) }
dsUnliftedBind (AbsBindsSig { abs_tvs = []
, abs_ev_vars = []
, abs_sig_export = poly
, abs_sig_ev_bind = ev_bind
, abs_sig_bind = L _ bind }) body
= do { ds_binds <- dsTcEvBinds ev_bind
; body' <- dsUnliftedBind (bind { fun_id = noLoc poly }) body
; return (mkCoreLets ds_binds body') }
dsUnliftedBind (FunBind { fun_id = L l fun
, fun_matches = matches
, fun_co_fn = co_fn
......
......@@ -1475,7 +1475,6 @@ rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
; return (srcLocSpan (getSrcLoc v), ans) }
rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
rep_bind (L _ (AbsBindsSig {})) = panic "rep_bind: AbsBindsSig"
rep_bind (L loc (PatSynBind (PSB { psb_id = syn
, psb_fvs = _fvs
, psb_args = args
......
......@@ -269,22 +269,9 @@ data HsBindLR idL idR
abs_ev_binds :: [TcEvBinds],
-- | Typechecked user bindings
abs_binds :: LHsBinds idL
}
-- | Abstraction Bindings Signature
| AbsBindsSig { -- Simpler form of AbsBinds, used with a type sig
-- in tcPolyCheck. Produces simpler desugaring and
-- is necessary to avoid #11405, comment:3.
abs_tvs :: [TyVar],
abs_ev_vars :: [EvVar],
abs_sig_export :: IdP idL, -- like abe_poly
abs_sig_prags :: TcSpecPrags,
abs_binds :: LHsBinds idL,
abs_sig_ev_bind :: TcEvBinds, -- no list needed here
abs_sig_bind :: LHsBind idL -- always only one, and it's always a
-- FunBind
abs_sig :: Bool -- See Note [The abs_sig field of AbsBinds]
}
-- | Patterns Synonym Binding
......@@ -312,7 +299,7 @@ deriving instance (DataId idL, DataId idR) => Data (HsBindLR idL idR)
-- | Abtraction Bindings Export
data ABExport p
= ABE { abe_poly :: IdP p -- ^ Any INLINE pragmas is attached to this Id
= ABE { abe_poly :: IdP p -- ^ Any INLINE pragma is attached to this Id
, abe_mono :: IdP p
, abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper]
-- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
......@@ -481,6 +468,53 @@ bindings only when
lacks a user type signature
* The group forms a strongly connected component
Note [The abs_sig field of AbsBinds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The abs_sig field supports a couple of special cases for bindings.
Consider
x :: Num a => (# a, a #)
x = (# 3, 4 #)
The general desugaring for AbsBinds would give
x = /\a. \ ($dNum :: Num a) ->
letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in
xm
But that has an illegal let-binding for an unboxed tuple. In this
case we'd prefer to generate the (more direct)
x = /\ a. \ ($dNum :: Num a) ->
(# fromInteger $dNum 3, fromInteger $dNum 4 #)
A similar thing happens with representation-polymorphic defns
(Trac #11405):
undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
undef = error "undef"
Again, the vanilla desugaring gives a local let-binding for a
representation-polymorphic (undefm :: a), which is illegal. But
again we can desugar without a let:
undef = /\ a. \ (d:HasCallStack) -> error a d "undef"
The abs_sig field supports this direct desugaring, with no local
let-bining. When abs_sig = True
* the abs_binds is single FunBind
* the abs_exports is a singleton
* we have a complete type sig for binder
and hence the abs_binds is non-recursive
(it binds the mono_id but refers to the poly_id
These properties are exploited in DsBinds.dsAbsBinds to
generate code without a let-binding.
Note [ABExport wrapper]
~~~~~~~~~~~~~~~~~~~~~~~
Consider
......@@ -662,21 +696,6 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
, text "Evidence:" <+> ppr ev_binds ]
else
pprLHsBinds val_binds
ppr_monobind (AbsBindsSig { abs_tvs = tyvars
, abs_ev_vars = dictvars
, abs_sig_export = poly_id
, abs_sig_ev_bind = ev_bind
, abs_sig_bind = bind })
= sdocWithDynFlags $ \ dflags ->
if gopt Opt_PrintTypecheckerElaboration dflags then
hang (text "AbsBindsSig" <+> brackets (interpp'SP tyvars)
<+> brackets (interpp'SP dictvars))
2 $ braces $ vcat
[ text "Exported type:" <+> pprBndr LetBind poly_id
, text "Bind:" <+> ppr bind
, text "Evidence:" <+> ppr ev_bind ]
else
ppr bind
instance (OutputableBndrId p) => Outputable (ABExport p) where
ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
......
......@@ -577,8 +577,6 @@ looksLazyPatBind (PatBind { pat_lhs = p })
= looksLazyLPat p
looksLazyPatBind (AbsBinds { abs_binds = binds })
= anyBag (looksLazyPatBind . unLoc) binds
looksLazyPatBind (AbsBindsSig { abs_sig_bind = L _ bind })
= looksLazyPatBind bind
looksLazyPatBind _
= False
......
......@@ -796,49 +796,31 @@ to return a [Name] or [Id]. Before renaming the record punning
and wild-card mechanism makes it hard to know what is bound.
So these functions should not be applied to (HsSyn RdrName)
Note [Unlifted id check in isHsUnliftedBind]
Note [Unlifted id check in isUnliftedHsBind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose there is a binding with the type (Num a => (# a, a #)). Is this a
strict binding that should be disallowed at the top level? At first glance,
no, because it's a function. But consider how this is desugared via
AbsBinds:
The function isUnliftedHsBind is used to complain if we make a top-level
binding for a variable of unlifted type.
-- x :: Num a => (# a, a #)
x = (# 3, 4 #)
Such a binding is illegal if the top-level binding would be unlifted;
but also if the local letrec generated by desugaring AbsBinds would be.
E.g.
f :: Num a => (# a, a #)
g :: Num a => a -> a
f = ...g...
g = ...g...
becomes
The top-level bindings for f,g are not unlifted (because of the Num a =>),
but the local, recursive, monomorphic bindings are:
x = \ $dictNum ->
let x_mono = (# fromInteger $dictNum 3, fromInteger $dictNum 4 #) in
x_mono
t = /\a \(d:Num a).
letrec fm :: (# a, a #) = ...g...
gm :: a -> a = ...f...
in (fm, gm)
Note that the inner let is strict. And thus if we have a bunch of mutually
recursive bindings of this form, we could end up in trouble. This was shown
up in #9140.
But if there is a type signature on x, everything changes because of the
desugaring used by AbsBindsSig:
x :: Num a => (# a, a #)
x = (# 3, 4 #)
becomes
x = \ $dictNum -> (# fromInteger $dictNum 3, fromInteger $dictNum 4 #)
No strictness anymore! The bottom line here is that, for inferred types, we
care about the strictness of the type after the =>. For checked types
(AbsBindsSig), we care about the overall strictness.
This matters. If we don't separate out the AbsBindsSig case, then GHC runs into
a problem when compiling
undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
Looking only after the =>, we cannot tell if this is strict or not. (GHC panics
if you try.) Looking at the whole type, on the other hand, tells you that this
is a lifted function type, with no trouble at all.
Here the binding for 'fm' is illegal. So generally we check the abe_mono types.
BUT we have a special case when abs_sig is true;
see HsBinds Note [The abs_sig field of AbsBinds]
-}
----------------- Bindings --------------------------
......@@ -848,18 +830,19 @@ is a lifted function type, with no trouble at all.
-- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
-- information, see Note [Strict binds check] is DsBinds.
isUnliftedHsBind :: HsBind GhcTc -> Bool -- works only over typechecked binds
isUnliftedHsBind (AbsBindsSig { abs_sig_export = id })
= isUnliftedType (idType id)
isUnliftedHsBind bind
| AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind
= if has_sig
then any (is_unlifted_id . abe_poly) exports
else any (is_unlifted_id . abe_mono) exports
-- If has_sig is True we wil never generate a binding for abe_mono,
-- so we don't need to worry about it being unlifted. The abe_poly
-- binding might not be: e.g. forall a. Num a => (# a, a #)
| otherwise
= any is_unlifted_id (collectHsBindBinders bind)
where
is_unlifted_id id
= case tcSplitSigmaTy (idType id) of
(_, _, tau) -> isUnliftedType tau
-- For the is_unlifted check, we need to look inside polymorphism
-- and overloading. E.g. x = (# 1, True #)
-- would get type forall a. Num a => (# a, Bool #)
-- and we want to reject that. See Trac #9140
is_unlifted_id id = isUnliftedType (idType id)
-- | Is a binding a strict variable bind (e.g. @!x = ...@)?
isBangedBind :: HsBind GhcTc -> Bool
......@@ -911,7 +894,6 @@ collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++
-- I don't think we want the binders from the abe_binds
-- The only time we collect binders from a typechecked
-- binding (hence see AbsBinds) is in zonking in TcHsSyn
collect_bind _ (AbsBindsSig { abs_sig_export = poly }) acc = poly : acc
collect_bind omitPatSyn (PatSynBind (PSB { psb_id = L _ ps })) acc
| omitPatSyn = acc
| otherwise = ps : acc
......
......@@ -38,7 +38,7 @@ import FamInstEnv( normaliseType )
import FamInst( tcGetFamInstEnvs )
import TyCon
import TcType
import Type( mkStrLitTy, tidyOpenType, mkTyVarBinder, splitTyConApp_maybe)
import Type( mkStrLitTy, tidyOpenType, splitTyConApp_maybe)
import TysPrim
import TysWiredIn( cTupleTyConName )
import Id
......@@ -717,13 +717,18 @@ tcPolyCheck prag_fn
, bind_fvs = placeHolderNamesTc
, fun_tick = funBindTicks nm_loc mono_id mod prag_sigs }
abs_bind = L loc $ AbsBindsSig
{ abs_sig_export = poly_id
, abs_tvs = skol_tvs
, abs_ev_vars = ev_vars
, abs_sig_prags = SpecPrags spec_prags
, abs_sig_ev_bind = ev_binds
, abs_sig_bind = L loc bind' }
export = ABE { abe_wrap = idHsWrapper
, abe_poly = poly_id
, abe_mono = mono_id
, abe_prags = SpecPrags spec_prags }
abs_bind = L loc $
AbsBinds { abs_tvs = skol_tvs
, abs_ev_vars = ev_vars
, abs_ev_binds = [ev_binds]
, abs_exports = [export]
, abs_binds = unitBag (L loc bind')
, abs_sig = True }
; return (unitBag abs_bind, [poly_id]) }
......@@ -799,7 +804,8 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
abs_bind = L loc $
AbsBinds { abs_tvs = qtvs
, abs_ev_vars = givens, abs_ev_binds = [ev_binds]
, abs_exports = exports, abs_binds = binds' }
, abs_exports = exports, abs_binds = binds'
, abs_sig = False }
; traceTc "Binding:" (ppr (poly_ids `zip` map idType poly_ids))
; return (unitBag abs_bind, poly_ids) }
......@@ -858,9 +864,9 @@ mkExport prag_fn insoluble qtvs theta
; return (ABE { abe_wrap = wrap
-- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty)
, abe_poly = poly_id
, abe_mono = mono_id
, abe_prags = SpecPrags spec_prags}) }
, abe_poly = poly_id
, abe_mono = mono_id
, abe_prags = SpecPrags spec_prags }) }
where
prag_sigs = lookupPragEnv prag_fn poly_name
sig_ctxt = InfSigCtxt poly_name
......@@ -1611,7 +1617,7 @@ data GeneralisationPlan
| CheckGen (LHsBind GhcRn) TcIdSigInfo
-- One FunBind with a signature
-- Explicit generalisation; there is an AbsBindsSig
-- Explicit generalisation
-- A consequence of the no-AbsBinds choice (NoGen) is that there is
-- no "polymorphic Id" and "monmomorphic Id"; there is just the one
......
......@@ -278,14 +278,15 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn
(L bind_loc lm_bind)
; let export = ABE { abe_poly = global_dm_id
, abe_mono = local_dm_id
, abe_wrap = idHsWrapper
, abe_prags = IsDefaultMethod }
, abe_mono = local_dm_id
, abe_wrap = idHsWrapper
, abe_prags = IsDefaultMethod }
full_bind = AbsBinds { abs_tvs = tyvars
, abs_ev_vars = [this_dict]
, abs_exports = [export]
, abs_ev_binds = [ev_binds]
, abs_binds = tc_bind }
, abs_binds = tc_bind
, abs_sig = True }
; return (unitBag (L bind_loc full_bind)) }
......
......@@ -455,24 +455,44 @@ zonk_bind env bind@(FunBind { fun_id = L loc var, fun_matches = ms
zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
, abs_ev_binds = ev_binds
, abs_exports = exports
, abs_binds = val_binds })
, abs_binds = val_binds
, abs_sig = has_sig })
= ASSERT( all isImmutableTyVar tyvars )
do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
; (env1, new_evs) <- zonkEvBndrsX env0 evs
; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds
; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) ->
do { let env3 = extendIdZonkEnvRec env2
(collectHsBindsBinders new_val_binds)
; new_val_binds <- zonkMonoBinds env3 val_binds
; new_exports <- mapM (zonkExport env3) exports
do { let env3 = extendIdZonkEnvRec env2 $
collectHsBindsBinders new_val_binds
; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds
; new_exports <- mapM (zonk_export env3) exports
; return (new_val_binds, new_exports) }
; return (AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs
, abs_ev_binds = new_ev_binds
, abs_exports = new_exports, abs_binds = new_val_bind }) }
, abs_exports = new_exports, abs_binds = new_val_bind
, abs_sig = has_sig }) }
where
zonkExport env (ABE{ abe_wrap = wrap
, abe_poly = poly_id
, abe_mono = mono_id, abe_prags = prags })
zonk_val_bind env lbind
| has_sig
, L loc bind@(FunBind { fun_id = L mloc mono_id
, fun_matches = ms
, fun_co_fn = co_fn }) <- lbind
= do { new_mono_id <- updateVarTypeM (zonkTcTypeToType env) mono_id
-- Specifically /not/ zonkIdBndr; we do not
-- want to complain about a levity-polymorphic binder
; (env', new_co_fn) <- zonkCoFn env co_fn
; new_ms <- zonkMatchGroup env' zonkLExpr ms
; return $ L loc $
bind { fun_id = L mloc new_mono_id
, fun_matches = new_ms
, fun_co_fn = new_co_fn } }
| otherwise
= zonk_lbind env lbind -- The normal case
zonk_export env (ABE{ abe_wrap = wrap
, abe_poly = poly_id
, abe_mono = mono_id
, abe_prags = prags })
= do new_poly_id <- zonkIdBndr env poly_id
(_, new_wrap) <- zonkCoFn env wrap
new_prags <- zonkSpecPrags env prags
......@@ -481,44 +501,6 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
, abe_mono = zonkIdOcc env mono_id
, abe_prags = new_prags })
zonk_bind env outer_bind@(AbsBindsSig { abs_tvs = tyvars
, abs_ev_vars = evs
, abs_sig_export = poly
, abs_sig_prags = prags
, abs_sig_ev_bind = ev_bind
, abs_sig_bind = lbind })
| L bind_loc bind@(FunBind { fun_id = L loc local
, fun_matches = ms
, fun_co_fn = co_fn }) <- lbind
= ASSERT( all isImmutableTyVar tyvars )
do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
; (env1, new_evs) <- zonkEvBndrsX env0 evs
; (env2, new_ev_bind) <- zonkTcEvBinds env1 ev_bind
-- Inline zonk_bind (FunBind ...) because we wish to skip
-- the check for representation-polymorphic binders. The
-- local binder in the FunBind in an AbsBindsSig is never actually
-- bound in Core -- indeed, that's the whole point of AbsBindsSig.
-- just calling zonk_bind causes #11405.
; new_local <- updateVarTypeM (zonkTcTypeToType env2) local
; (env3, new_co_fn) <- zonkCoFn env2 co_fn
; new_ms <- zonkMatchGroup env3 zonkLExpr ms
-- If there is a representation polymorphism problem, it will
-- be caught here:
; new_poly_id <- zonkIdBndr env2 poly
; new_prags <- zonkSpecPrags env2 prags
; let new_val_bind = L bind_loc (bind { fun_id = L loc new_local
, fun_matches = new_ms
, fun_co_fn = new_co_fn })
; return (AbsBindsSig { abs_tvs = new_tyvars
, abs_ev_vars = new_evs
, abs_sig_export = new_poly_id
, abs_sig_prags = new_prags
, abs_sig_ev_bind = new_ev_bind
, abs_sig_bind = new_val_bind }) }
| otherwise
= pprPanic "zonk_bind" (ppr outer_bind)
zonk_bind env (PatSynBind bind@(PSB { psb_id = L loc id
, psb_args = details
, psb_def = lpat
......
......@@ -889,7 +889,8 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
, abs_ev_vars = dfun_ev_vars
, abs_exports = [export]
, abs_ev_binds = []
, abs_binds = unitBag dict_bind }
, abs_binds = unitBag dict_bind
, abs_sig = True }
; return (unitBag (L loc main_bind) `unionBags` sc_meth_binds)
}
......@@ -1037,7 +1038,8 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds sc_theta
, abs_ev_vars = dfun_evs
, abs_exports = [export]
, abs_ev_binds = [dfun_ev_binds, local_ev_binds]
, abs_binds = emptyBag }
, abs_binds = emptyBag
, abs_sig = False }
; return (sc_top_id, L loc bind, sc_implic) }
-------------------
......@@ -1374,17 +1376,18 @@ tcMethodBody clas tyvars dfun_ev_vars inst_tys
; spec_prags <- tcSpecPrags global_meth_id prags
; let specs = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags
export = ABE { abe_poly = global_meth_id
, abe_mono = local_meth_id
, abe_wrap = idHsWrapper
, abe_prags = specs }
export = ABE { abe_poly = global_meth_id
, abe_mono = local_meth_id
, abe_wrap = idHsWrapper
, abe_prags = specs }
local_ev_binds = TcEvBinds ev_binds_var
full_bind = AbsBinds { abs_tvs = tyvars
, abs_ev_vars = dfun_ev_vars
, abs_exports = [export]
, abs_ev_binds = [dfun_ev_binds, local_ev_binds]
, abs_binds = tc_bind }
, abs_binds = tc_bind
, abs_sig = True }
; return (global_meth_id, L bind_loc full_bind, Just meth_implic) }
where
......@@ -1429,7 +1432,8 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
; return (unitBag $ L (getLoc meth_bind) $
AbsBinds { abs_tvs = [], abs_ev_vars = []
, abs_exports = [export]
, abs_binds = tc_bind, abs_ev_binds = [] }) }
, abs_binds = tc_bind, abs_ev_binds = []
, abs_sig = True }) }
| otherwise -- No instance signature
= do { let ctxt = FunSigCtxt sel_name False
......
......@@ -34,8 +34,6 @@ main = do
where
isDataCon (L _ (AbsBinds { abs_binds = bs }))
= not (isEmptyBag (filterBag isDataCon bs))
isDataCon (L _ (AbsBindsSig { abs_sig_bind = b }))
= isDataCon b
isDataCon (L l (f@FunBind {}))
| (MG (L _ (m:_)) _ _ _) <- fun_matches f,
(L _ (c@ConPatOut{}):_)<-hsLMatchPats m,
......
......@@ -275,5 +275,6 @@
(FromSource))
(WpHole) {NameSet:
[]}
[]))]}))]}
[]))]}
(False)))]}
......@@ -284,7 +284,6 @@ boundThings modname lbinding =
PatBind { pat_lhs = lhs } -> patThings lhs []
VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
AbsBinds { } -> [] -- nothing interesting in a type abstraction
AbsBindsSig { } -> []
PatSynBind PSB{ psb_id = id } -> [thing id]
where thing = foundOfLName modname
patThings lpat tl =
......
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