#include "HsVersions.h"
import CmdLineOpts ( DynFlag(..), DynFlags(..), dopt, opt_SccProfilingOn )
+import DriverPhases ( isHsBoot )
import HscTypes ( ModGuts(..), ModGuts, HscEnv(..), GhciMode(..),
Dependencies(..), TypeEnv, IsBootInterface )
import HsSyn ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
HsBindGroup(..), LRuleDecl, HsBind(..) )
import TcRnTypes ( TcGblEnv(..), ImportAvails(..) )
import MkIface ( mkUsageInfo )
-import Id ( Id, setIdExported, idName, idIsFrom, isLocalId )
+import Id ( Id, setIdExported, idName, idIsFrom )
import Name ( Name, isExternalName )
import CoreSyn
import PprCore ( pprIdRules, pprCoreExpr )
-import Subst ( SubstResult(..), substExpr, mkSubst, extendIdSubstList )
+import CoreSubst ( substExpr, mkSubst )
import DsMonad
import DsExpr ( dsLExpr )
import DsBinds ( dsHsBinds, AutoScc(..) )
import Bag ( Bag, isEmptyBag, emptyBag, bagToList )
import CoreLint ( showPass, endPass )
import CoreFVs ( ruleRhsFreeVars )
-import Packages ( PackageState(thPackageId) )
+import Packages ( PackageState(thPackageId), PackageIdH(..) )
import ErrUtils ( doIfSet, dumpIfSet_dyn, pprBagOfWarnings,
errorsFound, WarnMsg )
import ListSetOps ( insertList )
deSugar hsc_env
tcg_env@(TcGblEnv { tcg_mod = mod,
+ tcg_src = hsc_src,
tcg_type_env = type_env,
tcg_imports = imports,
tcg_exports = exports,
; th_used <- readIORef th_var -- Whether TH is used
; let used_names = allUses dus `unionNameSets` dfun_uses
thPackage = thPackageId (pkgState dflags)
- pkgs | Just th_id <- thPackage, th_used
+ pkgs | ExtPackage th_id <- thPackage, th_used
= insertList th_id (imp_dep_pkgs imports)
| otherwise
= imp_dep_pkgs imports
mod_guts = ModGuts {
mg_module = mod,
+ mg_boot = isHsBoot hsc_src,
mg_exports = exports,
mg_deps = deps,
mg_usages = usages,
-- Substitute the dict bindings eagerly,
-- and take the body apart into a (f args) form
let
- subst = extendIdSubstList (mkSubst all_vars) pairs
- pairs = [(id, ContEx subst rhs) | (id,rhs) <- dict_binds']
+ subst = mkSubst all_vars emptyVarEnv (mkVarEnv id_pairs)
+ id_pairs = [(id, substExpr subst rhs) | (id,rhs) <- dict_binds']
-- Note recursion here... substitution won't terminate
-- if there is genuine recursion... which there isn't
+
body'' = substExpr subst body'
in