Commit 2a34e381 authored by keithw's avatar keithw
Browse files

[project @ 1999-05-11 16:41:56 by keithw]

(this is number 5a of 9 commits to be applied together)

  The major purpose of this commit is to introduce usage information
  and usage analysis into the compiler, per the paper _Once Upon a
  Polymorphic Type_ (Keith Wansbrough and Simon Peyton Jones, POPL'99,
  and Glasgow TR-1998-19).

  An analysis is provided that annotates a Core program with optimal
  usage annotations.  This analysis is performed by -fusagesp
  (=CoreDoUSPInf), and requires -fusagesp-on (=opt_UsageSPOn).  This
  latter performs an analysis in tidyCorePgm, immediately before
  CoreToStg is done.  The driver flag -fusagesp currently provides hsc
  with -fusagesp-on, and if -O is on does a single -fusagesp early on
  in the Core-to-Core sequence.  Please change this as desired.

  *NB*: For now, -fusagesp with -O requires -fno-specialise.  Sorry.

  The flags -ddump-usagesp (=opt_D_dump_usagesp) and -dusagesp-lint
  (=opt_DoUSPLinting) (also -dnousagesp-lint to the driver) have been
  added and are documented in the User Guide.
parent d133b73a
......@@ -41,6 +41,7 @@ module CmdLineOpts (
opt_D_dump_cpranal,
opt_D_dump_worker_wrapper,
opt_D_dump_tc,
opt_D_dump_usagesp,
opt_D_show_passes,
opt_D_show_rn_trace,
opt_D_show_rn_imports,
......@@ -50,6 +51,7 @@ module CmdLineOpts (
opt_D_verbose_stg2stg,
opt_DictsStrict,
opt_DoCoreLinting,
opt_DoUSPLinting,
opt_DoStgLinting,
opt_DoSemiTagging,
opt_DoEtaReduction,
......@@ -58,6 +60,7 @@ module CmdLineOpts (
opt_EnsureSplittableC,
opt_FoldrBuildOn,
opt_UnboxStrictFields,
opt_UsageSPOn,
opt_GlasgowExts,
opt_GranMacros,
opt_HiMap,
......@@ -180,6 +183,7 @@ data CoreToDo -- These are diff core-to-core passes,
| CoreDoSpecialising
| CoreDoFoldrBuildWorkerWrapper
| CoreDoFoldrBuildWWAnal
| CoreDoUSPInf
| CoreDoCPResult
\end{code}
......@@ -315,6 +319,7 @@ opt_D_dump_stranal = lookUp SLIT("-ddump-stranal")
opt_D_dump_worker_wrapper = lookUp SLIT("-ddump-workwrap")
opt_D_dump_cpranal = lookUp SLIT("-ddump-cpranalyse")
opt_D_dump_tc = lookUp SLIT("-ddump-tc")
opt_D_dump_usagesp = lookUp SLIT("-ddump-usagesp")
opt_D_show_passes = lookUp SLIT("-dshow-passes")
opt_D_show_rn_trace = lookUp SLIT("-dshow-rn-trace")
opt_D_show_rn_imports = lookUp SLIT("-dshow-rn-imports")
......@@ -326,8 +331,10 @@ opt_DictsStrict = lookUp SLIT("-fdicts-strict")
opt_DoCoreLinting = lookUp SLIT("-dcore-lint")
opt_DoStgLinting = lookUp SLIT("-dstg-lint")
opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging")
opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
opt_DoUSPLinting = lookUp SLIT("-dusagesp-lint")
opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls")
opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names")
opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on")
......@@ -425,7 +432,8 @@ classifyOpts = sep argv [] [] -- accumulators...
"-fworker-wrapper" -> CORE_TD(CoreDoWorkerWrapper)
"-fspecialise" -> CORE_TD(CoreDoSpecialising)
"-ffoldr-build-worker-wrapper" -> CORE_TD(CoreDoFoldrBuildWorkerWrapper)
"-ffoldr-build-ww-anal" -> CORE_TD(CoreDoFoldrBuildWWAnal)
"-ffoldr-build-ww-anal" -> CORE_TD(CoreDoFoldrBuildWWAnal)
"-fusagesp" -> CORE_TD(CoreDoUSPInf)
"-fcpr-analyse" -> CORE_TD(CoreDoCPResult)
"-fstg-static-args" -> STG_TD(StgDoStaticArgs)
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[UConSet]{UsageSP constraint solver}
This code is (based on) PhD work of Keith Wansbrough <kw217@cl.cam.ac.uk>,
February 1998 .. April 1999.
Keith Wansbrough 1998-02-16..1999-04-29
\begin{code}
module UConSet ( UConSet,
emptyUConSet,
eqManyUConSet,
eqUConSet,
leqUConSet,
unionUCS,
unionUCSs,
solveUCS,
) where
#include "HsVersions.h"
import VarEnv
import Type ( UsageAnn(..) )
import Var ( UVar )
import Monad ( foldM )
import Bag ( Bag, unitBag, emptyBag, unionBags, foldlBag, bagToList )
import Outputable
import PprType
\end{code}
======================================================================
The data type:
~~~~~~~~~~~~~~
First, individual constraints on particular variables. This is
private to the implementation.
\begin{code}
data UCon = UCEq UVar UVar -- j = k (equivalence)
| UCBound [UVar] UVar [UVar] -- {..} <= j <= {..}
| UCUsOnce UVar -- j = 1
| UCUsMany UVar -- j = omega
\end{code}
Next, the public (but abstract) data type for a usage constraint set:
either a bag of mappings from @UVar@ to @UCon@, or an error message
for an inconsistent constraint set.
\begin{code}
data UConSet = UConSet (Bag (VarEnv UCon))
| UConFail SDoc
\end{code}
The idea is that the @VarEnv@s (which will eventually be merged into a
single @VarEnv@) are union-find data structures: a variable is either
equal to another variable, or it is bounded or has a value. The
equalities form a forest pointing to a root node for each equality
class, on which is found the bound or value for that class.
The @Bag@ enables two-phase operation: we merely collect constraints
in the first phase, an donly union them at solution time. This gives
a much more efficient algorithm, as we make only a single pass over
the constraints.
Note that the absence of a variable from the @VarEnv@ is exactly
equivalent to it being mapped to @UCBound [] _ []@.
The interface:
~~~~~~~~~~~~~~
@emptyUConSet@ gives an empty constraint set.
@eqManyUConSet@ constrains an annotation to be Many.
@eqUConSet@ constrains two annotations to be equal.
@leqUConSet@ constrains one annotation to be less than or equal to
another (with Once < Many).
\begin{code}
mkUCS = UConSet . unitBag -- helper function not exported
emptyUConSet :: UConSet
emptyUConSet = UConSet emptyBag
eqManyUConSet :: UsageAnn -> UConSet
eqManyUConSet UsOnce = UConFail (text "Once /= Many")
eqManyUConSet UsMany = emptyUConSet
eqManyUConSet (UsVar uv) = mkUCS $ unitVarEnv uv (UCUsMany uv)
eqUConSet :: UsageAnn -> UsageAnn -> UConSet
eqUConSet UsOnce UsOnce = emptyUConSet
eqUConSet UsOnce (UsVar uv) = mkUCS $ unitVarEnv uv (UCUsOnce uv)
eqUConSet UsMany UsMany = emptyUConSet
eqUConSet UsMany (UsVar uv) = mkUCS $ unitVarEnv uv (UCUsMany uv)
eqUConSet (UsVar uv) UsOnce = mkUCS $ unitVarEnv uv (UCUsOnce uv)
eqUConSet (UsVar uv) UsMany = mkUCS $ unitVarEnv uv (UCUsMany uv)
eqUConSet (UsVar uv) (UsVar uv') = if uv==uv'
then emptyUConSet
else mkUCS $ unitVarEnv uv (UCEq uv uv')
eqUConSet UsMany UsOnce = UConFail (text "Many /= Once")
eqUConSet UsOnce UsMany = UConFail (text "Once /= Many")
leqUConSet :: UsageAnn -> UsageAnn -> UConSet
leqUConSet UsOnce _ = emptyUConSet
leqUConSet _ UsMany = emptyUConSet
leqUConSet UsMany UsOnce = UConFail (text "Many /<= Once")
leqUConSet UsMany (UsVar uv) = mkUCS $ unitVarEnv uv (UCUsMany uv)
leqUConSet (UsVar uv) UsOnce = mkUCS $ unitVarEnv uv (UCUsOnce uv)
leqUConSet (UsVar uv) (UsVar uv') = mkUCS $ mkVarEnv [(uv, UCBound [] uv [uv']),
(uv',UCBound [uv] uv' [] )]
\end{code}
@unionUCS@ forms the union of two @UConSet@s.
@unionUCSs@ forms the `big union' of a list of @UConSet@s.
\begin{code}
unionUCS :: UConSet -> UConSet -> UConSet
unionUCS (UConSet b1) (UConSet b2) = UConSet (b1 `unionBags` b2)
unionUCS ucs@(UConFail _) _ = ucs -- favour first error
unionUCS (UConSet _) ucs@(UConFail _) = ucs
unionUCSs :: [UConSet] -> UConSet
unionUCSs ucss = foldl unionUCS emptyUConSet ucss
\end{code}
@solveUCS@ finds the minimal solution to the constraint set, returning
it as @Just@ a substitution function taking usage variables to usage
annotations (@UsOnce@ or @UsMany@). If this is not possible (for an
inconsistent constraint set), @solveUCS@ returns @Nothing@.
The minimal solution is found by simply reading off the known
variables, and for unknown ones substituting @UsOnce@.
\begin{code}
solveUCS :: UConSet -> Maybe (UVar -> UsageAnn)
solveUCS (UConSet css)
= case foldlBag (\cs1 jcs2 -> foldVarEnv addUCS cs1 jcs2)
(Left emptyVarEnv)
css of
Left cs -> let cs' = mapVarEnv conToSub cs
sub uv = case lookupVarEnv cs' uv of
Just u -> u
Nothing -> UsOnce
conToSub (UCEq _ uv') = case lookupVarEnv cs uv' of
Nothing -> UsOnce
Just con' -> conToSub con'
conToSub (UCUsOnce _ ) = UsOnce
conToSub (UCUsMany _ ) = UsMany
conToSub (UCBound _ _ _ ) = UsOnce
in Just sub
Right err -> solveUCS (UConFail err)
solveUCS (UConFail why) =
#ifdef DEBUG
pprTrace "UConFail:" why $
#endif
Nothing
\end{code}
======================================================================
The internals:
~~~~~~~~~~~~~~
In the internals, we use the @VarEnv UCon@ explicitly, or occasionally
@Either (VarEnv UCon) SDoc@. In other words, the @Bag@ is no longer
used.
@findUCon@ finds the root of an equivalence class.
@changeUConUVar@ copies a constraint, but changes the variable constrained.
\begin{code}
findUCon :: VarEnv UCon -> UVar -> UVar
findUCon cs uv
= case lookupVarEnv cs uv of
Just (UCEq _ uv') -> findUCon cs uv'
Just _ -> uv
Nothing -> uv
changeUConUVar :: UCon -> UVar -> UCon
changeUConUVar (UCEq _ v ) uv' = (UCEq uv' v )
changeUConUVar (UCBound us _ vs) uv' = (UCBound us uv' vs)
changeUConUVar (UCUsOnce _ ) uv' = (UCUsOnce uv' )
changeUConUVar (UCUsMany _ ) uv' = (UCUsMany uv' )
\end{code}
@mergeUVars@ tests to see if a set of @UVar@s can be constrained. If
they can, it returns the set of root @UVar@s represented (with no
duplicates); if they can't, it returns @Nothing@.
\begin{code}
mergeUVars :: VarEnv UCon -- current constraint set
-> Bool -- True/False = try to constrain to Many/Once
-> [UVar] -- list of UVars to constrain
-> Maybe [UVar] -- Just [root uvars to force], or Nothing if conflict
mergeUVars cs isMany vs = foldl muv (Just []) vs
where
muv :: Maybe [UVar] -> UVar -> Maybe [UVar]
muv Nothing _
= Nothing
muv jvs@(Just vs) v
= let rv = findUCon cs v
in if elem rv vs
then
jvs
else
case lookupVarEnv cs rv of -- never UCEq
Nothing -> Just (rv:vs)
Just (UCBound _ _ _) -> Just (rv:vs)
Just (UCUsOnce _) -> if isMany then Nothing else jvs
Just (UCUsMany _) -> if isMany then jvs else Nothing
\end{code}
@addUCS@ adds an individual @UCon@ on a @UVar@ to a @UConSet@. This
is the core of the algorithm. As such, it could probably use some
optimising.
\begin{code}
addUCS :: UCon -- constraint to add
-> Either (VarEnv UCon) SDoc -- old constraint set or error
-> Either (VarEnv UCon) SDoc -- new constraint set or error
addUCS _ jcs@(Right _) = jcs -- propagate errors
addUCS (UCEq uv1 uv2) jcs@(Left cs)
= let ruv1 = findUCon cs uv1
ruv2 = findUCon cs uv2
in if ruv1==ruv2
then jcs -- no change if already equal
else let cs' = Left $ extendVarEnv cs ruv1 (UCEq ruv1 ruv2) -- merge trees
in case lookupVarEnv cs ruv1 of
Just uc'
-> addUCS (changeUConUVar uc' ruv2) cs' -- merge old constraints
Nothing
-> cs'
addUCS (UCBound us uv1 vs) jcs@(Left cs)
= let ruv1 = findUCon cs uv1
in case lookupWithDefaultVarEnv cs (UCBound [] ruv1 []) ruv1 of -- never UCEq
UCBound us' _ vs'
-> case (mergeUVars cs False (us'++us),
mergeUVars cs True (vs'++vs)) of
(Just us'',Just vs'') -- update
-> Left $ extendVarEnv cs ruv1 (UCBound us'' ruv1 vs'')
(Nothing, Just vs'') -- set
-> addUCS (UCUsMany ruv1)
(forceUVars UCUsMany vs'' jcs)
(Just us'',Nothing) -- set
-> addUCS (UCUsOnce ruv1)
(forceUVars UCUsOnce us'' jcs)
(Nothing, Nothing) -- fail
-> Right (text "union failed[B] at" <+> ppr uv1)
UCUsOnce _
-> forceUVars UCUsOnce us jcs
UCUsMany _
-> forceUVars UCUsMany vs jcs
addUCS (UCUsOnce uv1) jcs@(Left cs)
= let ruv1 = findUCon cs uv1
in case lookupWithDefaultVarEnv cs (UCBound [] ruv1 []) ruv1 of -- never UCEq
UCBound us _ vs
-> forceUVars UCUsOnce us (Left $ extendVarEnv cs ruv1 (UCUsOnce ruv1))
UCUsOnce _
-> jcs
UCUsMany _
-> Right (text "union failed[O] at" <+> ppr uv1)
addUCS (UCUsMany uv1) jcs@(Left cs)
= let ruv1 = findUCon cs uv1
in case lookupWithDefaultVarEnv cs (UCBound [] ruv1 []) ruv1 of -- never UCEq
UCBound us _ vs
-> forceUVars UCUsMany vs (Left $ extendVarEnv cs ruv1 (UCUsMany ruv1))
UCUsOnce _
-> Right (text "union failed[M] at" <+> ppr uv1)
UCUsMany _
-> jcs
-- helper function forcing a set of UVars to either Once or Many:
forceUVars :: (UVar -> UCon)
-> [UVar]
-> Either (VarEnv UCon) SDoc
-> Either (VarEnv UCon) SDoc
forceUVars uc uvs cs0 = foldl (\cs uv -> addUCS (uc uv) cs) cs0 uvs
\end{code}
======================================================================
Pretty-printing:
~~~~~~~~~~~~~~~~
\begin{code}
-- Printing a usage constraint.
pprintUCon :: VarEnv UCon -> UCon -> SDoc
pprintUCon fm (UCEq uv1 uv2)
= ppr uv1 <+> text "=" <+> ppr uv2 <> text ":"
<+> let uv2' = findUCon fm uv2
in case lookupVarEnv fm uv2' of
Just uc -> pprintUCon fm uc
Nothing -> text "unconstrained"
pprintUCon fm (UCBound us uv vs)
= lbrace <> hcat (punctuate comma (map ppr us)) <> rbrace
<+> text "<=" <+> ppr uv <+> text "<="
<+> lbrace <> hcat (punctuate comma (map ppr vs)) <> rbrace
pprintUCon fm (UCUsOnce uv)
= ppr uv <+> text "=" <+> ppr UsOnce
pprintUCon fm (UCUsMany uv)
= ppr uv <+> text "=" <+> ppr UsMany
-- Printing a usage constraint set.
instance Outputable UConSet where
ppr (UConSet bfm)
= text "UConSet:" <+> lbrace
$$ vcat (map (\fm -> nest 2 (vcat (map (pprintUCon fm) (rngVarEnv fm))))
(bagToList bfm))
$$ rbrace
ppr (UConFail d)
= hang (text "UConSet inconsistent:")
4 d
\end{code}
======================================================================
EOF
This diff is collapsed.
%
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[UsageSPLint]{UsageSP ``lint'' pass}
This code is (based on) PhD work of Keith Wansbrough <kw217@cl.cam.ac.uk>,
September 1998 .. May 1999.
Keith Wansbrough 1998-09-04..1999-05-03
\begin{code}
module UsageSPLint ( doLintUSPAnnotsBinds,
doLintUSPConstBinds,
doLintUSPBinds,
doCheckIfWorseUSP,
) where
#include "HsVersions.h"
import UsageSPUtils
import CoreSyn
import Type ( Type(..), TyNote(..), UsageAnn(..), isUsgTy, tyUsg )
import TyCon ( isAlgTyCon, isPrimTyCon, isSynTyCon, isFunTyCon )
import Var ( IdOrTyVar, varType, idInfo )
import IdInfo ( LBVarInfo(..), lbvarInfo )
import SrcLoc ( noSrcLoc )
import ErrUtils ( Message, ghcExit )
import Util ( zipWithEqual )
import PprCore
import Bag
import Outputable
\end{code}
======================================================================
Interface
~~~~~~~~~
@doLintUSPAnnotsBinds@ checks that annotations are in the correct positions.
@doLintUSPConstsBinds@ checks that no @UVar@s remain anywhere (i.e., all annots are constants).
@doLintUSPBinds@ checks that the annotations are consistent. [unimplemented!]
@doCheckIfWorseUSP@ checks that annots on binders have not changed from Once to Many.
\begin{code}
doLint :: ULintM a -> IO ()
doLint m = case runULM m of
Nothing -> return ()
Just bad_news -> do { printDump (display bad_news)
; ghcExit 1
}
where display bad_news = vcat [ text "*** LintUSP errors: ***"
, bad_news
, text "*** end of LintUSP errors ***"
]
doLintUSPAnnotsBinds, doLintUSPConstBinds :: [CoreBind] -> IO ()
doLintUSPAnnotsBinds = doLint . lintUSPAnnotsBinds
doLintUSPConstBinds = doLint . lintUSPConstBinds
-- doLintUSPBinds is defined below
doCheckIfWorseUSP :: [CoreBind] -> [CoreBind] -> IO ()
doCheckIfWorseUSP binds binds'
= case checkIfWorseUSP binds binds' of
Nothing -> return ()
Just warns -> printErrs warns
\end{code}
======================================================================
Verifying correct annotation positioning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The following functions check whether the usage annotations are
correctly placed on a type. They sit inside the lint monad.
@lintUSPAnnots@ assumes there should be an outermost annotation,
@lintUSPAnnotsN@ assumes there shouldn't.
The fact that no general catch-all pattern is given for @NoteTy@s is
entirely intentional. The meaning of future extensions here is
entirely unknown, so you'll have to decide how to check them
explicitly.
\begin{code}
lintTyUSPAnnots :: Bool -- die on omitted annotation?
-> Bool -- die on extra annotation?
-> Type -- type to check
-> ULintM ()
lintTyUSPAnnots fom fex = lint
where
lint (NoteTy (UsgNote _) ty) = lintTyUSPAnnotsN fom fex ty
lint ty0 = do { mayErrULM fom "missing UsgNote" ty0
; lintTyUSPAnnotsN fom fex ty0
}
lintTyUSPAnnotsN :: Bool -- die on omitted annotation?
-> Bool -- die on extra annotation?
-> Type -- type to check
-> ULintM ()
lintTyUSPAnnotsN fom fex = lintN
where
lintN ty0@(NoteTy (UsgNote _) ty) = do { mayErrULM fex "unexpected UsgNote" ty0
; lintN ty
}
lintN (NoteTy (SynNote sty) ty) = do { lintN sty
; lintN ty
}
lintN (NoteTy (FTVNote _) ty) = do { lintN ty }
lintN (TyVarTy _) = do { return () }
lintN (AppTy ty1 ty2) = do { lintN ty1
; lintN ty2
}
lintN (TyConApp tc tys) = ASSERT( isFunTyCon tc || isAlgTyCon tc || isPrimTyCon tc || isSynTyCon tc )
do { let thelint = if isFunTyCon tc
then lintTyUSPAnnots fom fex
else lintN
; mapM thelint tys
; return ()
}
lintN (FunTy ty1 ty2) = do { lintTyUSPAnnots fom fex ty1
; lintTyUSPAnnots fom fex ty2
}
lintN (ForAllTy _ ty) = do { lintN ty }
\end{code}
Now the combined function that takes a @MungeFlags@ to tell it what to
do to a particular type. This is passed to @genAnnotBinds@ to get the
work done.
\begin{code}
lintUSPAnnotsTyM :: MungeFlags -> Type -> AnnotM (ULintM ()) Type
lintUSPAnnotsTyM mf ty = AnnotM $ \ m ve ->
(ty, do { m
; atLocULM (mfLoc mf) $
(if isSigma mf
then lintTyUSPAnnots
else lintTyUSPAnnotsN) checkOmitted True ty
},
ve)
#ifndef USMANY
where checkOmitted = False -- OK to omit Many if !USMANY
#else
where checkOmitted = True -- require all annotations
#endif
lintUSPAnnotsBinds :: [CoreBind]
-> ULintM ()
lintUSPAnnotsBinds binds = case initAnnotM (return ()) $
genAnnotBinds lintUSPAnnotsTyM return binds of
-- **! should check with mungeTerm too!
(_,m) -> m
\end{code}
======================================================================
Verifying correct usage typing
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The following function verifies that all usage annotations are
consistent. It assumes that there are no usage variables, only
@UsOnce@ and @UsMany@ annotations.
This is very similar to usage inference, however, and so we could
simply use that, with a little work. For now, it's unimplemented.
\begin{code}
doLintUSPBinds :: [CoreBind] -> IO ()
doLintUSPBinds binds = panic "doLintUSPBinds unimplemented"
{- case initUs us (uniqSMMToUs (usgInfBinds binds)) of
((ucs,_),_) -> if isJust (solveUCS ucs)
then return ()
else do { printDump (text "*** LintUSPBinds failed ***")
; ghcExit 1
}
-}
\end{code}
======================================================================
Verifying usage constants only (not vars)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The following function checks that all usage annotations are ground,
i.e., @UsOnce@ or @UsMany@: no @UVar@s remain.
\begin{code}
lintTyUSPConst :: Type
-> ULintM ()
lintTyUSPConst (TyVarTy _) = do { return () }
lintTyUSPConst (AppTy ty1 ty2) = do { lintTyUSPConst ty1
; lintTyUSPConst ty2
}
lintTyUSPConst (TyConApp tc tys) = do { mapM lintTyUSPConst tys
; return ()
}
lintTyUSPConst (FunTy ty1 ty2) = do { lintTyUSPConst ty1
; lintTyUSPConst ty2
}
lintTyUSPConst (ForAllTy _ ty) = do { lintTyUSPConst ty }
lintTyUSPConst ty0@(NoteTy (UsgNote (UsVar _)) ty) = do { errULM "unexpected usage variable" ty0
; lintTyUSPConst ty
}
lintTyUSPConst ty0@(NoteTy (UsgNote _) ty) = do { lintTyUSPConst ty }
lintTyUSPConst ty0@(NoteTy (SynNote sty) ty) = do { lintTyUSPConst sty
; lintTyUSPConst ty
}
lintTyUSPConst ty0@(NoteTy (FTVNote _) ty) = do { lintTyUSPConst ty }
\end{code}
Now the combined function and the invocation of @genAnnotBinds@ to do the real work.
\begin{code}
lintUSPConstTyM :: MungeFlags -> Type -> AnnotM (ULintM ()) Type
lintUSPConstTyM mf ty = AnnotM $ \ m ve ->
(ty,
do { m
; atLocULM (mfLoc mf) $
lintTyUSPConst ty
},
ve)
lintUSPConstBinds :: [CoreBind]
-> ULintM ()