- case maybe_spec_name of
- Nothing -> -- Just specialise "f" by building a SpecPragmaId binding
- -- It is the thing that makes sure we don't prematurely
- -- dead-code-eliminate the binding we are really interested in.
- newSpecPragmaId name sig_ty `thenNF_Tc` \ spec_id ->
- returnTc (Nothing, VarMonoBind spec_id spec_expr, spec_lie)
-
- Just g_name -> -- Don't create a SpecPragmaId. Instead add some suitable IdIfo
-
- panic "Can't handle SPECIALISE with a '= g' part"
-
- {- Not yet. Because we're still in the TcType world we
- can't really add to the SpecEnv of the Id. Instead we have to
- record the information in a different sort of Sig, and add it to
- the IdInfo after zonking.
-
- For now we just leave out this case
-
- -- Get the type of f, and find out what types
- -- f has to be instantiated at to give the signature type
- tcLookupValue name `thenNF_Tc` \ f_id ->
- tcInstTcType (idType f_id) `thenNF_Tc` \ (f_tyvars, f_rho) ->
-
- let
- (sig_tyvars, sig_theta, sig_tau) = splitSigmaTy sig_ty
- (f_theta, f_tau) = splitRhoTy f_rho
- sig_tyvar_set = mkVarSet sig_tyvars
- in
- unifyTauTy sig_tau f_tau `thenTc_`
-
- tcPolyExpr str (HsVar g_name) (mkSigmaTy sig_tyvars f_theta sig_tau) `thenTc` \ (_, _,
- -}
-
-tcPragmaSig other = pprTrace "tcPragmaSig: ignoring" (ppr other) $
- returnTc (Nothing, EmptyMonoBinds, emptyLIE)
+ -- Squeeze out any Methods (see comments with tcSimplifyToDicts)
+ tcSimplifyToDicts spec_lie `thenTc` \ (spec_lie1, spec_binds) ->
+
+ -- Just specialise "f" by building a SpecPragmaId binding
+ -- It is the thing that makes sure we don't prematurely
+ -- dead-code-eliminate the binding we are really interested in.
+ newSpecPragmaId name sig_ty `thenNF_Tc` \ spec_id ->
+
+ -- Do the rest and combine
+ tcSpecSigs sigs `thenTc` \ (binds_rest, lie_rest) ->
+ returnTc (binds_rest `andMonoBinds` VarMonoBind spec_id (mkHsLet spec_binds spec_expr),
+ lie_rest `plusLIE` spec_lie1)
+
+tcSpecSigs (other_sig : sigs) = tcSpecSigs sigs
+tcSpecSigs [] = returnTc (EmptyMonoBinds, emptyLIE)