projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Print more nicely in -ddump-splices
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcBinds.lhs
diff --git
a/compiler/typecheck/TcBinds.lhs
b/compiler/typecheck/TcBinds.lhs
index
7cafd3c
..
59cd315
100644
(file)
--- a/
compiler/typecheck/TcBinds.lhs
+++ b/
compiler/typecheck/TcBinds.lhs
@@
-6,7
+6,7
@@
\begin{code}
module TcBinds ( tcLocalBinds, tcTopBinds,
\begin{code}
module TcBinds ( tcLocalBinds, tcTopBinds,
- tcHsBootSigs, tcMonoBinds,
+ tcHsBootSigs, tcMonoBinds, tcPolyBinds,
TcPragFun, tcSpecPrag, tcPrags, mkPragFun,
TcSigInfo(..), TcSigFun, mkTcSigFun,
badBootDeclErr ) where
TcPragFun, tcSpecPrag, tcPrags, mkPragFun,
TcSigInfo(..), TcSigFun, mkTcSigFun,
badBootDeclErr ) where
@@
-31,8
+31,7
@@
import Coercion
import VarEnv
import TysPrim
import Id
import VarEnv
import TysPrim
import Id
-import IdInfo
-import Var hiding (mkLocalId)
+import Var
import Name
import NameSet
import NameEnv
import Name
import NameSet
import NameEnv
@@
-99,11
+98,11
@@
tcHsBootSigs :: HsValBinds Name -> TcM [Id]
-- signatures in it. The renamer checked all this
tcHsBootSigs (ValBindsOut binds sigs)
= do { checkTc (null binds) badBootDeclErr
-- signatures in it. The renamer checked all this
tcHsBootSigs (ValBindsOut binds sigs)
= do { checkTc (null binds) badBootDeclErr
- ; mapM (addLocM tc_boot_sig) (filter isVanillaLSig sigs) }
+ ; mapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
where
tc_boot_sig (TypeSig (L _ name) ty)
= do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
where
tc_boot_sig (TypeSig (L _ name) ty)
= do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
- ; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) }
+ ; return (mkVanillaGlobal name sigma_ty) }
-- Notice that we make GlobalIds, not LocalIds
tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s)
tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
-- Notice that we make GlobalIds, not LocalIds
tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s)
tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
@@
-152,10
+151,10
@@
tcValBinds _ (ValBindsIn binds _) _
tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
= do { -- Typecheck the signature
; let { prag_fn = mkPragFun sigs
tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
= do { -- Typecheck the signature
; let { prag_fn = mkPragFun sigs
- ; ty_sigs = filter isVanillaLSig sigs
+ ; ty_sigs = filter isTypeLSig sigs
; sig_fn = mkTcSigFun ty_sigs }
; sig_fn = mkTcSigFun ty_sigs }
- ; poly_ids <- mapM tcTySig ty_sigs
+ ; poly_ids <- checkNoErrs (mapAndRecoverM tcTySig ty_sigs)
-- No recovery from bad signatures, because the type sigs
-- may bind type variables, so proceeding without them
-- can lead to a cascade of errors
-- No recovery from bad signatures, because the type sigs
-- may bind type variables, so proceeding without them
-- can lead to a cascade of errors
@@
-166,26
+165,29
@@
tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
-- the Ids declared with type signatures
; poly_rec <- doptM Opt_RelaxedPolyRec
; (binds', thing) <- tcExtendIdEnv poly_ids $
-- the Ids declared with type signatures
; poly_rec <- doptM Opt_RelaxedPolyRec
; (binds', thing) <- tcExtendIdEnv poly_ids $
- tc_val_binds poly_rec top_lvl sig_fn prag_fn
+ tcBindGroups poly_rec top_lvl sig_fn prag_fn
binds thing_inside
; return (ValBindsOut binds' sigs, thing) }
------------------------
binds thing_inside
; return (ValBindsOut binds' sigs, thing) }
------------------------
-tc_val_binds :: Bool -> TopLevelFlag -> TcSigFun -> TcPragFun
+tcBindGroups :: Bool -> TopLevelFlag -> TcSigFun -> TcPragFun
-> [(RecFlag, LHsBinds Name)] -> TcM thing
-> TcM ([(RecFlag, LHsBinds TcId)], thing)
-- Typecheck a whole lot of value bindings,
-- one strongly-connected component at a time
-> [(RecFlag, LHsBinds Name)] -> TcM thing
-> TcM ([(RecFlag, LHsBinds TcId)], thing)
-- Typecheck a whole lot of value bindings,
-- one strongly-connected component at a time
+-- Here a "strongly connected component" has the strightforward
+-- meaning of a group of bindings that mention each other,
+-- ignoring type signatures (that part comes later)
-tc_val_binds _ _ _ _ [] thing_inside
+tcBindGroups _ _ _ _ [] thing_inside
= do { thing <- thing_inside
; return ([], thing) }
= do { thing <- thing_inside
; return ([], thing) }
-tc_val_binds poly_rec top_lvl sig_fn prag_fn (group : groups) thing_inside
+tcBindGroups poly_rec top_lvl sig_fn prag_fn (group : groups) thing_inside
= do { (group', (groups', thing))
<- tc_group poly_rec top_lvl sig_fn prag_fn group $
= do { (group', (groups', thing))
<- tc_group poly_rec top_lvl sig_fn prag_fn group $
- tc_val_binds poly_rec top_lvl sig_fn prag_fn groups thing_inside
+ tcBindGroups poly_rec top_lvl sig_fn prag_fn groups thing_inside
; return (group' ++ groups', thing) }
------------------------
; return (group' ++ groups', thing) }
------------------------
@@
-201,32
+203,36
@@
tc_group _ top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
-- A single non-recursive binding
-- We want to keep non-recursive things non-recursive
-- so that we desugar unlifted bindings correctly
-- A single non-recursive binding
-- We want to keep non-recursive things non-recursive
-- so that we desugar unlifted bindings correctly
- = do { (binds, thing) <- tc_haskell98 top_lvl sig_fn prag_fn NonRecursive binds thing_inside
- ; return ([(NonRecursive, b) | b <- binds], thing) }
+ = do { (binds1, lie_binds, thing) <- tc_haskell98 top_lvl sig_fn prag_fn
+ NonRecursive binds thing_inside
+ ; return ( [(NonRecursive, unitBag b) | b <- bagToList binds1]
+ ++ [(Recursive, lie_binds)] -- TcDictBinds have scrambled dependency order
+ , thing) }
tc_group poly_rec top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
| not poly_rec -- Recursive group, normal Haskell 98 route
tc_group poly_rec top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
| not poly_rec -- Recursive group, normal Haskell 98 route
- = do { (binds1, thing) <- tc_haskell98 top_lvl sig_fn prag_fn Recursive binds thing_inside
- ; return ([(Recursive, unionManyBags binds1)], thing) }
+ = do { (binds1, lie_binds, thing) <- tc_haskell98 top_lvl sig_fn prag_fn
+ Recursive binds thing_inside
+ ; return ([(Recursive, binds1 `unionBags` lie_binds)], thing) }
- | otherwise -- Recursive group, with gla-exts
- = -- To maximise polymorphism (with -fglasgow-exts), we do a new
+ | otherwise -- Recursive group, with -XRelaxedPolyRec
+ = -- To maximise polymorphism (with -XRelaxedPolyRec), we do a new
-- strongly-connected-component analysis, this time omitting
-- any references to variables with type signatures.
--
-- strongly-connected-component analysis, this time omitting
-- any references to variables with type signatures.
--
- -- Notice that the bindInsts thing covers *all* the bindings in the original
- -- group at once; an earlier one may use a later one!
+ -- Notice that the bindInsts thing covers *all* the bindings in
+ -- the original group at once; an earlier one may use a later one!
do { traceTc (text "tc_group rec" <+> pprLHsBinds binds)
do { traceTc (text "tc_group rec" <+> pprLHsBinds binds)
- ; (binds1,thing) <- bindLocalInsts top_lvl $
- go (stronglyConnComp (mkEdges sig_fn binds))
- ; return ([(Recursive, unionManyBags binds1)], thing) }
+ ; (binds1,lie_binds,thing) <- bindLocalInsts top_lvl $
+ go (stronglyConnCompFromEdgedVertices (mkEdges sig_fn binds))
+ ; return ([(Recursive, binds1 `unionBags` lie_binds)], thing) }
-- Rec them all together
where
-- Rec them all together
where
--- go :: SCC (LHsBind Name) -> TcM ([LHsBind TcId], [TcId], thing)
+-- go :: SCC (LHsBind Name) -> TcM (LHsBinds TcId, [TcId], thing)
go (scc:sccs) = do { (binds1, ids1) <- tc_scc scc
; (binds2, ids2, thing) <- tcExtendIdEnv ids1 $ go sccs
go (scc:sccs) = do { (binds1, ids1) <- tc_scc scc
; (binds2, ids2, thing) <- tcExtendIdEnv ids1 $ go sccs
- ; return (binds1 ++ binds2, ids1 ++ ids2, thing) }
- go [] = do { thing <- thing_inside; return ([], [], thing) }
+ ; return (binds1 `unionBags` binds2, ids1 ++ ids2, thing) }
+ go [] = do { thing <- thing_inside; return (emptyBag, [], thing) }
tc_scc (AcyclicSCC bind) = tc_sub_group NonRecursive (unitBag bind)
tc_scc (CyclicSCC binds) = tc_sub_group Recursive (listToBag binds)
tc_scc (AcyclicSCC bind) = tc_sub_group NonRecursive (unitBag bind)
tc_scc (CyclicSCC binds) = tc_sub_group Recursive (listToBag binds)
@@
-234,17
+240,20
@@
tc_group poly_rec top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
tc_sub_group = tcPolyBinds top_lvl sig_fn prag_fn Recursive
tc_haskell98 :: TopLevelFlag -> TcSigFun -> TcPragFun -> RecFlag
tc_sub_group = tcPolyBinds top_lvl sig_fn prag_fn Recursive
tc_haskell98 :: TopLevelFlag -> TcSigFun -> TcPragFun -> RecFlag
- -> LHsBinds Name -> TcM a -> TcM ([LHsBinds TcId], a)
+ -> LHsBinds Name -> TcM a -> TcM (LHsBinds TcId, TcDictBinds, a)
tc_haskell98 top_lvl sig_fn prag_fn rec_flag binds thing_inside
tc_haskell98 top_lvl sig_fn prag_fn rec_flag binds thing_inside
- = bindLocalInsts top_lvl $ do
- { (binds1, ids) <- tcPolyBinds top_lvl sig_fn prag_fn rec_flag rec_flag binds
- ; thing <- tcExtendIdEnv ids thing_inside
- ; return (binds1, ids, thing) }
+ = bindLocalInsts top_lvl $
+ do { (binds1, ids) <- tcPolyBinds top_lvl sig_fn prag_fn rec_flag rec_flag binds
+ ; thing <- tcExtendIdEnv ids thing_inside
+ ; return (binds1, ids, thing) }
------------------------
------------------------
-bindLocalInsts :: TopLevelFlag -> TcM ([LHsBinds TcId], [TcId], a) -> TcM ([LHsBinds TcId], a)
+bindLocalInsts :: TopLevelFlag
+ -> TcM (LHsBinds TcId, [TcId], a)
+ -> TcM (LHsBinds TcId, TcDictBinds, a)
bindLocalInsts top_lvl thing_inside
bindLocalInsts top_lvl thing_inside
- | isTopLevel top_lvl = do { (binds, _, thing) <- thing_inside; return (binds, thing) }
+ | isTopLevel top_lvl
+ = do { (binds, _, thing) <- thing_inside; return (binds, emptyBag, thing) }
-- For the top level don't bother with all this bindInstsOfLocalFuns stuff.
-- All the top level things are rec'd together anyway, so it's fine to
-- leave them to the tcSimplifyTop, and quite a bit faster too
-- For the top level don't bother with all this bindInstsOfLocalFuns stuff.
-- All the top level things are rec'd together anyway, so it's fine to
-- leave them to the tcSimplifyTop, and quite a bit faster too
@@
-252,7
+261,7
@@
bindLocalInsts top_lvl thing_inside
| otherwise -- Nested case
= do { ((binds, ids, thing), lie) <- getLIE thing_inside
; lie_binds <- bindInstsOfLocalFuns lie ids
| otherwise -- Nested case
= do { ((binds, ids, thing), lie) <- getLIE thing_inside
; lie_binds <- bindInstsOfLocalFuns lie ids
- ; return (binds ++ [lie_binds], thing) }
+ ; return (binds, lie_binds, thing) }
------------------------
mkEdges :: TcSigFun -> LHsBinds Name
------------------------
mkEdges :: TcSigFun -> LHsBinds Name
@@
-287,7
+296,7
@@
tcPolyBinds :: TopLevelFlag -> TcSigFun -> TcPragFun
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
-> LHsBinds Name
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
-> LHsBinds Name
- -> TcM ([LHsBinds TcId], [TcId])
+ -> TcM (LHsBinds TcId, [TcId])
-- Typechecks a single bunch of bindings all together,
-- and generalises them. The bunch may be only part of a recursive
-- Typechecks a single bunch of bindings all together,
-- and generalises them. The bunch may be only part of a recursive
@@
-332,7
+341,7
@@
tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
mk_export (_, Just sig, mono_id) _ = ([], sig_id sig, mono_id, [])
-- ToDo: prags for unlifted bindings
mk_export (_, Just sig, mono_id) _ = ([], sig_id sig, mono_id, [])
-- ToDo: prags for unlifted bindings
- ; return ( [unitBag $ L loc $ AbsBinds [] [] exports binds'],
+ ; return ( unitBag $ L loc $ AbsBinds [] [] exports binds',
[poly_id | (_, poly_id, _, _) <- exports]) } -- Guaranteed zonked
else do -- The normal lifted case: GENERALISE
[poly_id | (_, poly_id, _, _) <- exports]) } -- Guaranteed zonked
else do -- The normal lifted case: GENERALISE
@@
-353,7
+362,7
@@
tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
dict_vars exports
(dict_binds `unionBags` binds')
dict_vars exports
(dict_binds `unionBags` binds')
- ; return ([unitBag abs_bind], poly_ids) -- poly_ids are guaranteed zonked by mkExport
+ ; return (unitBag abs_bind, poly_ids) -- poly_ids are guaranteed zonked by mkExport
} }
} }
@@
-419,8
+428,7
@@
tcPrag :: TcId -> Sig Name -> TcM Prag
tcPrag poly_id (SpecSig _ hs_ty inl) = tcSpecPrag poly_id hs_ty inl
tcPrag poly_id (SpecInstSig hs_ty) = tcSpecPrag poly_id hs_ty defaultInlineSpec
tcPrag _ (InlineSig _ inl) = return (InlinePrag inl)
tcPrag poly_id (SpecSig _ hs_ty inl) = tcSpecPrag poly_id hs_ty inl
tcPrag poly_id (SpecInstSig hs_ty) = tcSpecPrag poly_id hs_ty defaultInlineSpec
tcPrag _ (InlineSig _ inl) = return (InlinePrag inl)
-tcPrag _ (FixSig {}) = panic "tcPrag FixSig"
-tcPrag _ (TypeSig {}) = panic "tcPrag TypeSig"
+tcPrag _ sig = pprPanic "tcPrag" (ppr sig)
tcSpecPrag :: TcId -> LHsType Name -> InlineSpec -> TcM Prag
tcSpecPrag :: TcId -> LHsType Name -> InlineSpec -> TcM Prag
@@
-437,11
+445,11
@@
tcSpecPrag poly_id hs_ty inl
-- signature-less binder given type (forall a.a), to minimise
-- subsequent error messages
recoveryCode :: [Name] -> (Name -> Maybe [Name])
-- signature-less binder given type (forall a.a), to minimise
-- subsequent error messages
recoveryCode :: [Name] -> (Name -> Maybe [Name])
- -> TcM ([Bag (LHsBindLR Id Var)], [Id])
+ -> TcM (LHsBinds TcId, [Id])
recoveryCode binder_names sig_fn
= do { traceTc (text "tcBindsWithSigs: error recovery" <+> ppr binder_names)
; poly_ids <- mapM mk_dummy binder_names
recoveryCode binder_names sig_fn
= do { traceTc (text "tcBindsWithSigs: error recovery" <+> ppr binder_names)
; poly_ids <- mapM mk_dummy binder_names
- ; return ([], poly_ids) }
+ ; return (emptyBag, poly_ids) }
where
mk_dummy name
| isJust (sig_fn name) = tcLookupId name -- Had signature; look it up
where
mk_dummy name
| isJust (sig_fn name) = tcLookupId name -- Had signature; look it up
@@
-467,6
+475,11
@@
checkStrictBinds top_lvl rec_group mbind mono_tys infos
(strictBindErr "Recursive" unlifted mbind)
; checkTc (isSingletonBag mbind)
(strictBindErr "Multiple" unlifted mbind)
(strictBindErr "Recursive" unlifted mbind)
; checkTc (isSingletonBag mbind)
(strictBindErr "Multiple" unlifted mbind)
+ -- This should be a checkTc, not a warnTc, but as of GHC 6.11
+ -- the versions of alex and happy available have non-conforming
+ -- templates, so the GHC build fails if it's an error:
+ ; warnTc (not bang_pat)
+ (unliftedMustBeBang mbind)
; mapM_ check_sig infos
; return True }
| otherwise
; mapM_ check_sig infos
; return True }
| otherwise
@@
-478,6
+491,11
@@
checkStrictBinds top_lvl rec_group mbind mono_tys infos
(badStrictSig unlifted sig)
check_sig _ = return ()
(badStrictSig unlifted sig)
check_sig _ = return ()
+unliftedMustBeBang :: LHsBindsLR Var Var -> SDoc
+unliftedMustBeBang mbind
+ = hang (text "Bindings containing unlifted types must use an outermost bang pattern:")
+ 4 (pprLHsBinds mbind)
+
strictBindErr :: String -> Bool -> LHsBindsLR Var Var -> SDoc
strictBindErr flavour unlifted mbind
= hang (text flavour <+> msg <+> ptext (sLit "aren't allowed:"))
strictBindErr :: String -> Bool -> LHsBindsLR Var Var -> SDoc
strictBindErr flavour unlifted mbind
= hang (text flavour <+> msg <+> ptext (sLit "aren't allowed:"))
@@
-561,8
+579,14
@@
tcMonoBinds [L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf,
-- Note that the scoped_tvs and the (sig_tvs sig)
-- may have different Names. That's quite ok.
-- Note that the scoped_tvs and the (sig_tvs sig)
-- may have different Names. That's quite ok.
+ ; traceTc (text "tcMoonBinds" <+> ppr scoped_tvs $$ ppr tc_sig)
; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs $
tcMatchesFun mono_name inf matches mono_ty
; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs $
tcMatchesFun mono_name inf matches mono_ty
+ -- Note that "mono_ty" might actually be a polymorphic type,
+ -- if the original function had a signature like
+ -- forall a. Eq a => forall b. Ord b => ....
+ -- But that's ok: tcMatchesFun can deal with that
+ -- It happens, too! See Note [Polymorphic methods] in TcClassDcl.
; let fun_bind' = FunBind { fun_id = L nm_loc mono_id,
fun_infix = inf, fun_matches = matches',
; let fun_bind' = FunBind { fun_id = L nm_loc mono_id,
fun_infix = inf, fun_matches = matches',
@@
-798,7
+822,7
@@
unifyCtxts (sig1 : sigs) -- Argument is always non-empty
-- where F is a type function and (F a ~ [a])
-- Then unification might succeed with a coercion. But it's much
-- much simpler to require that such signatures have identical contexts
-- where F is a type function and (F a ~ [a])
-- Then unification might succeed with a coercion. But it's much
-- much simpler to require that such signatures have identical contexts
- checkTc (all isIdentityCoercion cois)
+ checkTc (all isIdentityCoI cois)
(ptext (sLit "Mutually dependent functions have syntactically distinct contexts"))
}
(ptext (sLit "Mutually dependent functions have syntactically distinct contexts"))
}
@@
-860,7
+884,6
@@
checkDistinctTyVars sig_tvs
<+> ptext (sLit "is unified with another quantified type variable")
<+> quotes (ppr tidy_tv2)
; failWithTcM (env2, msg) }
<+> ptext (sLit "is unified with another quantified type variable")
<+> quotes (ppr tidy_tv2)
; failWithTcM (env2, msg) }
- where
\end{code}
\end{code}
@@
-1031,8
+1054,10
@@
mkTcSigFun :: [LSig Name] -> TcSigFun
-- Precondition: no duplicates
mkTcSigFun sigs = lookupNameEnv env
where
-- Precondition: no duplicates
mkTcSigFun sigs = lookupNameEnv env
where
- env = mkNameEnv [(name, hsExplicitTvs lhs_ty)
- | L _ (TypeSig (L _ name) lhs_ty) <- sigs]
+ env = mkNameEnv (mapCatMaybes mk_pair sigs)
+ mk_pair (L _ (TypeSig (L _ name) lhs_ty)) = Just (name, hsExplicitTvs lhs_ty)
+ mk_pair (L _ (IdSig id)) = Just (idName id, [])
+ mk_pair _ = Nothing
-- The scoped names are the ones explicitly mentioned
-- in the HsForAll. (There may be more in sigma_ty, because
-- of nested type synonyms. See Note [More instantiated than scoped].)
-- The scoped names are the ones explicitly mentioned
-- in the HsForAll. (There may be more in sigma_ty, because
-- of nested type synonyms. See Note [More instantiated than scoped].)
@@
-1086,6
+1111,8
@@
tcTySig (L span (TypeSig (L _ name) ty))
= setSrcSpan span $
do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; return (mkLocalId name sigma_ty) }
= setSrcSpan span $
do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; return (mkLocalId name sigma_ty) }
+tcTySig (L _ (IdSig id))
+ = return id
tcTySig s = pprPanic "tcTySig" (ppr s)
-------------------
tcTySig s = pprPanic "tcTySig" (ppr s)
-------------------
@@
-1122,9
+1149,8
@@
tcInstSig :: Bool -> Name -> TcM TcSigInfo
tcInstSig use_skols name
= do { poly_id <- tcLookupId name -- Cannot fail; the poly ids are put into
-- scope when starting the binding group
tcInstSig use_skols name
= do { poly_id <- tcLookupId name -- Cannot fail; the poly ids are put into
-- scope when starting the binding group
- ; let skol_info = SigSkol (FunSigCtxt name)
- inst_tyvars = tcInstSigTyVars use_skols skol_info
- ; (tvs, theta, tau) <- tcInstType inst_tyvars (idType poly_id)
+ ; let skol_info = SigSkol (FunSigCtxt name)
+ ; (tvs, theta, tau) <- tcInstSigType use_skols skol_info (idType poly_id)
; loc <- getInstLoc (SigOrigin skol_info)
; return (TcSigInfo { sig_id = poly_id,
sig_tvs = tvs, sig_theta = theta, sig_tau = tau,
; loc <- getInstLoc (SigOrigin skol_info)
; return (TcSigInfo { sig_id = poly_id,
sig_tvs = tvs, sig_theta = theta, sig_tau = tau,