[project @ 2000-11-20 14:48:52 by simonpj]

When renaming, typechecking an expression from the user
interface, we may suck in declarations from interface
files (e.g. the Prelude).  This commit takes account of that.

To do so, I did some significant restructuring in TcModule,
with consequential changes and tidy ups elsewhere in the type
checker.  I think there should be fewer lines in total than before.

ghc/compiler/compMan/CmLink.lhs

@@ -12,7 +12,9 @@ module CmLink ( Linkable(..),  Unlinked(..),
                 link, 
 		unload,
                 PersistentLinkerState{-abstractly!-}, emptyPLS,
+#ifdef GHCI
 		linkExpr
+#endif
   ) where
 
 

ghc/compiler/compMan/CompManager.lhs

@@ -5,7 +5,9 @@
 
 \begin{code}
 module CompManager ( cmInit, cmLoadModule,
+#ifdef GHCI
                      cmGetExpr, cmRunExpr,
+#endif
                      CmState, emptyCmState  -- abstract
                    )
 where
@@ -15,8 +17,6 @@ where
 import CmLink
 import CmTypes
 import HscTypes
-import HscMain		( hscExpr )
-import Interpreter	( HValue )
 import Module		( ModuleName, moduleName,
 			  isModuleInThisPackage, moduleEnvElts,
 			  moduleNameUserString )
@@ -26,7 +26,6 @@ import GetImports
 import HscTypes		( HomeSymbolTable, HomeIfaceTable, 
 			  PersistentCompilerState, ModDetails(..) )
 import Name		( lookupNameEnv )
-import RdrName
 import Module
 import PrelNames	( mainName )
 import HscMain		( initPersistentCompilerState )
@@ -36,11 +35,18 @@ import UniqFM		( emptyUFM, lookupUFM, addToUFM, delListFromUFM,
 import Unique		( Uniquable )
 import Digraph		( SCC(..), stronglyConnComp )
 import DriverUtil	( BarfKind(..), splitFilename3 )
-import CmdLineOpts	( DynFlags )
 import Util
 import Outputable
 import Panic		( panic )
 
+#ifdef GHCI
+import CmdLineOpts	( DynFlags )
+import Interpreter	( HValue )
+import HscMain		( hscExpr )
+import RdrName
+import PrelGHC		( unsafeCoerce# )
+#endif
+
 -- lang
 import Exception	( throwDyn )
 
@@ -50,7 +56,6 @@ import Directory        ( getModificationTime, doesFileExist )
 import IO
 import List		( nub )
 import Maybe		( catMaybes, fromMaybe, isJust )
-import PrelGHC		( unsafeCoerce# )
 \end{code}
 
 
@@ -59,6 +64,7 @@ cmInit :: PackageConfigInfo -> GhciMode -> IO CmState
 cmInit raw_package_info gmode
    = emptyCmState raw_package_info gmode
 
+#ifdef GHCI
 cmGetExpr :: CmState
 	  -> DynFlags
           -> ModuleName
@@ -83,6 +89,7 @@ cmRunExpr :: HValue -> IO ()
 cmRunExpr hval
    = do unsafeCoerce# hval :: IO ()
 	-- putStrLn "done."
+#endif
 
 -- Persistent state just for CM, excluding link & compile subsystems
 data PersistentCMState

ghc/compiler/coreSyn/CoreFVs.lhs

@@ -18,7 +18,7 @@ module CoreFVs (
 #include "HsVersions.h"
 
 import CoreSyn
-import Id		( Id, idName, idType, isLocalId, hasNoBinding, idSpecialisation )
+import Id		( Id, idType, isLocalId, hasNoBinding, idSpecialisation )
 import VarSet
 import Var		( Var, isId )
 import Type		( tyVarsOfType )

ghc/compiler/coreSyn/CoreUtils.lhs

@@ -54,10 +54,8 @@ import IdInfo		( LBVarInfo(..),
 			  IdFlavour(..),
 			  megaSeqIdInfo )
 import Demand		( appIsBottom )
-import Type		( Type, mkFunTy, mkForAllTy,
-			  splitFunTy_maybe, tyVarsOfType, tyVarsOfTypes,
-			  applyTys, isUnLiftedType, seqType,
-                          mkUTy
+import Type		( Type, mkFunTy, mkForAllTy, splitFunTy_maybe, 
+			  applyTys, isUnLiftedType, seqType, mkUTy
 			)
 import TysWiredIn	( boolTy, trueDataCon, falseDataCon )
 import CostCentre	( CostCentre )

ghc/compiler/coreSyn/PprCore.lhs

@@ -27,7 +27,7 @@ import IdInfo		( IdInfo, megaSeqIdInfo,
 			  arityInfo, ppArityInfo, ppFlavourInfo, flavourInfo,
 			  specInfo, cprInfo, ppCprInfo, 
 			  strictnessInfo, ppStrictnessInfo, cafInfo, ppCafInfo,
-			  cprInfo, ppCprInfo, lbvarInfo,
+			  cprInfo, ppCprInfo, 
 			  workerInfo, ppWorkerInfo,
                           tyGenInfo, ppTyGenInfo
 			)

ghc/compiler/hsSyn/HsDecls.lhs

@@ -282,7 +282,6 @@ instance (NamedThing name, Ord name) => Eq (TyClDecl name pat) where
 
   (==) _ _ = False	-- default case
 
-
 eq_hsFD env (ns1,ms1) (ns2,ms2)
   = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2
 

ghc/compiler/main/HscMain.lhs

@@ -9,17 +9,18 @@ module HscMain ( HscResult(..), hscMain, hscExpr,
 
 #include "HsVersions.h"
 
-import Maybe		( isJust )
-import IO		( hPutStrLn, stderr )
+#ifdef GHCI
+import RdrHsSyn		( RdrNameHsExpr )
+import CoreToStg	( coreToStgExpr )
+import StringBuffer	( stringToStringBuffer, freeStringBuffer )
+#endif
+
 import HsSyn
 
-import StringBuffer	( hGetStringBuffer, 
-			  stringToStringBuffer, freeStringBuffer )
+import StringBuffer	( hGetStringBuffer )
 import Parser
-import RdrHsSyn		( RdrNameHsExpr )
 import Lex		( PState(..), ParseResult(..) )
 import SrcLoc		( mkSrcLoc )
-
 import Rename
 import Rules		( emptyRuleBase )
 import PrelInfo		( wiredInThingEnv, wiredInThings )
@@ -33,7 +34,7 @@ import SimplCore
 import OccurAnal	( occurAnalyseBinds )
 import CoreUtils	( coreBindsSize )
 import CoreTidy		( tidyCorePgm )
-import CoreToStg	( topCoreBindsToStg, coreToStgExpr )
+import CoreToStg	( topCoreBindsToStg )
 import StgSyn		( collectFinalStgBinders )
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
@@ -47,7 +48,7 @@ import UniqSupply	( mkSplitUniqSupply )
 
 import Bag		( emptyBag )
 import Outputable
-import Interpreter
+import Interpreter	( stgBindsToInterpSyn, UnlinkedIExpr, UnlinkedIBind, ItblEnv )
 import CmStaticInfo	( GhciMode(..) )
 import HscStats		( ppSourceStats )
 import HscTypes		( ModDetails, ModIface(..), PersistentCompilerState(..),
@@ -62,6 +63,8 @@ import Name		( emptyNameEnv )
 import Module		( Module, lookupModuleEnvByName )
 
 import Monad		( when )
+import Maybe		( isJust )
+import IO		( hPutStrLn, stderr )
 \end{code}
 
 
@@ -131,7 +134,6 @@ hscNoRecomp ghci_mode dflags location (Just old_iface) hst hit pcs_ch
  | otherwise
  = do {
       hPutStrLn stderr "COMPILATION NOT REQUIRED";
-      let this_mod = mi_module old_iface
       ;
       -- CLOSURE
       (pcs_cl, closure_errs, cl_hs_decls) 
@@ -391,6 +393,11 @@ hscExpr
   -> String			-- The expression
   -> IO ( PersistentCompilerState, Maybe UnlinkedIExpr )
 
+#ifndef GHCI
+hscExpr dflags hst hit pcs this_module expr
+  = panic "hscExpr: non-interactive build"
+#else 
+
 hscExpr dflags hst hit pcs0 this_module expr
   = do	{ 	-- Parse it
 	maybe_parsed <- hscParseExpr dflags expr;
@@ -406,7 +413,7 @@ hscExpr dflags hst hit pcs0 this_module expr
 		Just (print_unqual, rn_expr) -> do {
 
 		-- Typecheck it
-	maybe_tc_expr <- typecheckExpr dflags pcs1 hst print_unqual rn_expr;
+	maybe_tc_expr <- typecheckExpr dflags pcs1 hst print_unqual this_module rn_expr;
 	case maybe_tc_expr of
 		Nothing -> return (pcs1, Nothing)
 		Just tc_expr -> do {
@@ -460,6 +467,7 @@ hscParseExpr dflags str
       
       return (Just rdr_expr)
       }}
+#endif
 \end{code}
 
 %************************************************************************

ghc/compiler/main/HscTypes.lhs

@@ -17,7 +17,7 @@ module HscTypes (
 
 	VersionInfo(..), initialVersionInfo,
 
-	TyThing(..), isTyClThing,
+	TyThing(..), isTyClThing, implicitTyThingIds,
 
 	TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, 
 	typeEnvClasses, typeEnvTyCons,
@@ -54,8 +54,9 @@ import Module		( Module, ModuleName, ModuleEnv,
 import InstEnv		( InstEnv, ClsInstEnv, DFunId )
 import Rules		( RuleBase )
 import Id		( Id )
-import Class		( Class )
-import TyCon		( TyCon )
+import Class		( Class, classSelIds )
+import TyCon		( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import DataCon		( dataConId, dataConWrapId )
 
 import BasicTypes	( Version, initialVersion, Fixity )
 
@@ -259,6 +260,18 @@ instance NamedThing TyThing where
 typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
 typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
 
+implicitTyThingIds :: [TyThing] -> [Id]
+-- Add the implicit data cons and selectors etc 
+implicitTyThingIds things
+  = concat (map go things)
+  where
+    go (AnId f)    = []
+    go (AClass cl) = classSelIds cl
+    go (ATyCon tc) = tyConGenIds tc ++
+		     tyConSelIds tc ++
+		     [ n | dc <- tyConDataConsIfAvailable tc, 
+			   n  <- [dataConId dc, dataConWrapId dc] ] 
+		-- Synonyms return empty list of constructors and selectors
 \end{code}
 
 

ghc/compiler/main/Interpreter.hs

 -----------------------------------------------------------------------------
--- $Id: Interpreter.hs,v 1.6 2000/11/20 14:26:27 simonmar Exp $
+-- $Id: Interpreter.hs,v 1.7 2000/11/20 14:48:54 simonpj Exp $
 --
 -- Interpreter subsystem wrapper
 --
@@ -16,7 +16,7 @@ module Interpreter (
     ClosureEnv, emptyClosureEnv, 
     ItblEnv, emptyItblEnv,
     linkIModules,
-    stgToInterpSyn,
+    stgToInterpSyn, stgBindsToInterpSyn,
     HValue,
     UnlinkedIBind, UnlinkedIExpr,
     loadObjs, resolveObjs,
@@ -55,9 +55,10 @@ data UnlinkedIExpr = UnlinkedIExpr
 instance Outputable UnlinkedIBind where
   ppr x = text "Can't output UnlinkedIBind"
 
-linkIModules	= error "linkIModules"
-stgToInterpSyn	= error "linkIModules"
-loadObjs	= error "loadObjs"
-resolveObjs	= error "loadObjs"
-interactiveUI   = error "interactiveUI"
+linkIModules	    = error "linkIModules"
+stgToInterpSyn	    = error "stgToInterpSyn"
+stgBindsToInterpSyn = error "stgBindsToInterpSyn"
+loadObjs	    = error "loadObjs"
+resolveObjs	    = error "loadObjs"
+interactiveUI       = error "interactiveUI"
 #endif

ghc/compiler/prelude/PrelInfo.lhs

@@ -32,15 +32,14 @@ module PrelInfo (
 import PrelNames	-- Prelude module names
 
 import PrimOp		( PrimOp(..), allThePrimOps, primOpRdrName )
-import DataCon		( DataCon, dataConId, dataConWrapId )
+import DataCon		( DataCon )
 import MkId		( mkPrimOpId, wiredInIds )
 import MkId		-- All of it, for re-export
 import TysPrim		( primTyCons )
 import TysWiredIn	( wiredInTyCons )
-import HscTypes 	( TyThing(..), TypeEnv, mkTypeEnv )
+import HscTypes 	( TyThing(..), implicitTyThingIds, TypeEnv, mkTypeEnv )
 
 -- others:
-import TyCon		( tyConDataConsIfAvailable, tyConGenIds, TyCon )
 import Class	 	( Class, classKey )
 import Type		( funTyCon )
 import Util		( isIn )
@@ -59,8 +58,9 @@ We have two ``builtin name funs,'' one to look up @TyCons@ and
 wiredInThings :: [TyThing]
 wiredInThings
   = concat
-    [		-- Wired in TyCons
-	  concat (map wiredInTyConThings ([funTyCon] ++ primTyCons ++ wiredInTyCons))
+    [		-- Wired in TyCons and their implicit Ids
+	  tycon_things
+	, map AnId (implicitTyThingIds tycon_things)
 
 		-- Wired in Ids
 	, map AnId wiredInIds
@@ -68,16 +68,8 @@ wiredInThings
 		-- PrimOps
 	, map (AnId . mkPrimOpId) allThePrimOps
     ]
-
-wiredInTyConThings :: TyCon -> [TyThing]
--- This is a bit of a cheat (c.f. TcTyDecls.mkImplicitDataBinds
--- It assumes that wired in tycons have no record selectors
-wiredInTyConThings tc
-   = [ATyCon tc] 
-   ++ [ AnId i | i <- tyConGenIds tc ]
-   ++ [ AnId n | dc <- tyConDataConsIfAvailable tc, 
-                 n  <- [dataConId dc, dataConWrapId dc] ] 
-			-- Synonyms return empty list of constructors
+  where
+    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons)
 
 wiredInThingEnv :: TypeEnv
 wiredInThingEnv = mkTypeEnv wiredInThings

ghc/compiler/prelude/TysWiredIn.lhs

@@ -168,7 +168,8 @@ pcTyCon new_or_data is_rec name tyvars argvrcs cons
                 []              -- No context
                 argvrcs
                 cons
-                (length cons)
+                (length cons) 
+		[]		-- No record selectors
                 new_or_data
                 is_rec
 		gen_info

ghc/compiler/rename/Rename.lhs

@@ -101,7 +101,7 @@ renameExpr :: DynFlags
 	   -> HomeIfaceTable -> HomeSymbolTable
 	   -> PersistentCompilerState 
 	   -> Module -> RdrNameHsExpr
-	   -> IO (PersistentCompilerState, Maybe (PrintUnqualified, RenamedHsExpr))
+	   -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (RenamedHsExpr, [RenamedHsDecl])))
 
 renameExpr dflags hit hst pcs this_module expr
   | Just iface <- lookupModuleEnv hit this_module
@@ -109,13 +109,11 @@ renameExpr dflags hit hst pcs this_module expr
 	; let print_unqual = unQualInScope rdr_env
 	  
 	; renameSource dflags hit hst pcs this_module $
-	  initRnMS rdr_env emptyLocalFixityEnv SourceMode $
-	  ( rnExpr expr `thenRn` \ (e,_) -> 
-
-	    doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
-	    ioToRnM (dumpIfSet dump_rn "Renamer:" (ppr e)) `thenRn_`
-
-	    returnRn (Just (print_unqual, e)))
+	  initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr)	`thenRn` \ (e,fvs) -> 
+	  closeDecls [] fvs						`thenRn` \ decls ->
+	  doptRn Opt_D_dump_rn						`thenRn` \ dump_rn ->
+	  ioToRnM (dumpIfSet dump_rn "Renamer:" (ppr e))		`thenRn_`
+	  returnRn (Just (print_unqual, (e, decls)))
 	}
 
   | otherwise

ghc/compiler/typecheck/TcClassDcl.lhs

@@ -4,13 +4,13 @@
 \section[TcClassDcl]{Typechecking class declarations}
 
 \begin{code}
-module TcClassDcl ( tcClassDecl1, tcClassDecls2, mkImplicitClassBinds,
+module TcClassDcl ( tcClassDecl1, tcClassDecls2, 
 		    tcMethodBind, badMethodErr
 		  ) where
 
 #include "HsVersions.h"
 
-import HsSyn		( HsDecl(..), TyClDecl(..), Sig(..), MonoBinds(..),
+import HsSyn		( TyClDecl(..), Sig(..), MonoBinds(..),
 			  HsExpr(..), HsLit(..), HsType(..), HsPred(..), 
 			  mkSimpleMatch, andMonoBinds, andMonoBindList, 
 			  isClassDecl, isClassOpSig, isPragSig,
@@ -19,10 +19,10 @@ import HsSyn		( HsDecl(..), TyClDecl(..), Sig(..), MonoBinds(..),
 import BasicTypes	( TopLevelFlag(..), RecFlag(..) )
 import RnHsSyn		( RenamedTyClDecl, 
 			  RenamedClassOpSig, RenamedMonoBinds,
-			  RenamedContext, RenamedHsDecl, RenamedSig, 
+			  RenamedContext, RenamedSig, 
 			  maybeGenericMatch
 			)
-import TcHsSyn		( TcMonoBinds, idsToMonoBinds )
+import TcHsSyn		( TcMonoBinds )
 
 import Inst		( InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs, 
 			  newDicts, newMethod )
@@ -37,7 +37,7 @@ import TcType		( TcType, TcTyVar, tcInstTyVars, zonkTcSigTyVars )
 import TcMonad
 import Generics		( mkGenericRhs, validGenericMethodType )
 import PrelInfo		( nO_METHOD_BINDING_ERROR_ID )
-import Class		( classTyVars, classBigSig, classSelIds, classTyCon, 
+import Class		( classTyVars, classBigSig, classTyCon, 
 			  Class, ClassOpItem, DefMeth (..) )
 import MkId		( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
 import DataCon		( mkDataCon, notMarkedStrict )
@@ -292,34 +292,6 @@ tcClassSig is_rec unf_env clas clas_tyvars dm_info
 \end{code}
 
 
-%************************************************************************
-%*									*
-\subsection[ClassDcl-pass2]{Class decls pass 2: default methods}
-%*									*
-%************************************************************************
-
-@mkImplicitClassBinds@ produces a binding for the selector function for each method
-and superclass dictionary.
-
-\begin{code}
-mkImplicitClassBinds :: Module -> [Class] -> NF_TcM ([Id], TcMonoBinds)
-mkImplicitClassBinds this_mod classes
-  = returnNF_Tc (concat cls_ids_s, andMonoBindList binds_s)
-	-- The selector binds are already in the selector Id's unfoldings
-	-- We don't return the data constructor etc from the class,
-	-- because that's done via the class's TyCon
-  where
-    (cls_ids_s, binds_s) = unzip (map mk_implicit classes)
-
-    mk_implicit clas = (sel_ids, binds)
-		     where
-			sel_ids = classSelIds clas
-			binds | isFrom this_mod clas = idsToMonoBinds sel_ids
-			      | otherwise 	     = EmptyMonoBinds
-\end{code}
-
-
-
 %************************************************************************
 %*									*
 \subsection[Default methods]{Default methods}
@@ -385,12 +357,12 @@ The function @tcClassDecls2@ just arranges to apply @tcClassDecl2@ to
 each local class decl.
 
 \begin{code}
-tcClassDecls2 :: Module -> [RenamedHsDecl] -> NF_TcM (LIE, TcMonoBinds)
+tcClassDecls2 :: Module -> [RenamedTyClDecl] -> NF_TcM (LIE, TcMonoBinds)
 
 tcClassDecls2 this_mod decls
   = foldr combine
 	  (returnNF_Tc (emptyLIE, EmptyMonoBinds))
-	  [tcClassDecl2 cls_decl | TyClD cls_decl <- decls, 
+	  [tcClassDecl2 cls_decl | cls_decl <- decls, 
 				   isClassDecl cls_decl,
 				   isFrom this_mod (tyClDeclName cls_decl)]
   where

ghc/compiler/typecheck/TcEnv.lhs

@@ -27,7 +27,7 @@ module TcEnv(
 	tcGetGlobalTyVars, tcExtendGlobalTyVars,
 
 	-- Random useful things
-	RecTcEnv, tcAddImportedIdInfo, tcLookupRecId, tcInstId,
+	RecTcEnv, tcAddImportedIdInfo, tcLookupRecId, tcLookupRecId_maybe, tcInstId,
 
 	-- New Ids
 	newLocalId, newSpecPragmaId,
@@ -165,7 +165,7 @@ getTcGEnv (TcEnv { tcGEnv = genv }) = genv
 -- This data type is used to help tie the knot
 -- when type checking type and class declarations
 data TyThingDetails = SynTyDetails Type
-		    | DataTyDetails ClassContext [DataCon]
+		    | DataTyDetails ClassContext [DataCon] [Id]
 		    | ClassDetails ClassContext [Id] [ClassOpItem] DataCon
 \end{code}
 
@@ -205,16 +205,20 @@ tcAddImportedIdInfo env id
   = id `lazySetIdInfo` new_info
 	-- The Id must be returned without a data dependency on maybe_id
   where
-    new_info = case tcLookupRecId env (idName id) of
+    new_info = case tcLookupRecId_maybe env (idName id) of
 		  Nothing	   -> constantIdInfo
 		  Just imported_id -> idInfo imported_id
 		-- ToDo: could check that types are the same
 
-tcLookupRecId :: RecTcEnv -> Name -> Maybe Id
-tcLookupRecId env name = case lookup_global env name of
-			   Just (AnId id) -> Just id
-			   other	  -> Nothing
+tcLookupRecId_maybe :: RecTcEnv -> Name -> Maybe Id
+tcLookupRecId_maybe env name = case lookup_global env name of
+				   Just (AnId id) -> Just id
+				   other	  -> Nothing
 
+tcLookupRecId ::  RecTcEnv -> Name -> Id
+tcLookupRecId env name = case lookup_global env name of
+				Just (AnId id) -> id
+				Nothing	       -> pprPanic "tcLookupRecId" (ppr name)
 \end{code}
 
 %************************************************************************
@@ -304,17 +308,21 @@ isLocalThing mod thing = case nameModule_maybe (getName thing) of
 %************************************************************************
 
 \begin{code}
-tcExtendGlobalEnv :: [(Name, TyThing)] -> TcM r -> TcM r
-tcExtendGlobalEnv bindings thing_inside
+tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
+tcExtendGlobalEnv things thing_inside
   = tcGetEnv				`thenNF_Tc` \ env ->
     let
-	ge' = extendNameEnvList (tcGEnv env) bindings
+	ge' = extendNameEnvList (tcGEnv env) [(getName thing, thing) | thing <- things]
     in
     tcSetEnv (env {tcGEnv = ge'}) thing_inside
 
 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
 tcExtendGlobalValEnv ids thing_inside
-  = tcExtendGlobalEnv [(getName id, AnId id) | id <- ids] thing_inside
+  = tcGetEnv				`thenNF_Tc` \ env ->
+    let
+	ge' = extendNameEnvList (tcGEnv env) [(getName id, AnId id) | id <- ids]
+    in
+    tcSetEnv (env {tcGEnv = ge'}) thing_inside
 \end{code}
 
 

ghc/compiler/typecheck/TcHsSyn.lhs

@@ -24,7 +24,6 @@ module TcHsSyn (
 
 	mkHsTyApp, mkHsDictApp, mkHsConApp,
 	mkHsTyLam, mkHsDictLam, mkHsLet,
-	idsToMonoBinds,
 
 	-- re-exported from TcEnv
 	TcId, tcInstId,
@@ -39,7 +38,7 @@ module TcHsSyn (
 import HsSyn	-- oodles of it
 
 -- others:
-import Id	( idName, idType, isLocalId, idUnfolding, setIdType, isIP, Id )
+import Id	( idName, idType, isLocalId, setIdType, isIP, Id )
 import DataCon	( dataConWrapId )	
 import TcEnv	( tcLookupGlobal_maybe, tcExtendGlobalValEnv,
 		  TcEnv, TcId, tcInstId
@@ -49,7 +48,6 @@ import TcMonad
 import TcType	( zonkTcTypeToType, zonkTcTyVarToTyVar, zonkTcType, zonkTcSigTyVars
 		)
 import CoreSyn  ( Expr )
-import CoreUnfold( unfoldingTemplate )
 import BasicTypes ( RecFlag(..) )
 import Bag
 import Outputable
@@ -118,12 +116,6 @@ mkHsLet EmptyMonoBinds expr = expr
 mkHsLet mbinds	       expr = HsLet (MonoBind mbinds [] Recursive) expr
 
 mkHsConApp data_con tys args = foldl HsApp (HsVar (dataConWrapId data_con) `mkHsTyApp` tys) args
-
-idsToMonoBinds :: [Id] -> TcMonoBinds 
-idsToMonoBinds ids
-  = andMonoBindList [ CoreMonoBind id (unfoldingTemplate (idUnfolding id))
-		    | id <- ids
-		    ]
 \end{code}
 
 %************************************************************************

ghc/compiler/typecheck/TcIfaceSig.lhs

@@ -8,7 +8,7 @@ module TcIfaceSig ( tcInterfaceSigs, tcVar, tcCoreExpr, tcCoreLamBndrs ) where
 
 #include "HsVersions.h"
 
-import HsSyn		( HsDecl(..), TyClDecl(..), HsTupCon(..) )
+import HsSyn		( TyClDecl(..), HsTupCon(..) )
 import TcMonad
 import TcMonoType	( tcHsType )
 				-- NB: all the tyars in interface files are kinded,
@@ -17,10 +17,10 @@ import TcMonoType	( tcHsType )
 
 import TcEnv		( TcEnv, RecTcEnv, tcExtendTyVarEnv, 
 			  tcExtendGlobalValEnv, tcSetEnv,
-			  tcLookupGlobal_maybe, tcLookupRecId
+			  tcLookupGlobal_maybe, tcLookupRecId_maybe
 			)
 
-import RnHsSyn		( RenamedHsDecl )
+import RnHsSyn		( RenamedTyClDecl )
 import HsCore
 import Literal		( Literal(..) )
 import CoreSyn
@@ -52,13 +52,13 @@ signatures.
 
 \begin{code}
 tcInterfaceSigs :: RecTcEnv		-- Envt to use when checking unfoldings
-		-> [RenamedHsDecl]	-- Ignore non-sig-decls in these decls
+		-> [RenamedTyClDecl]	-- Ignore non-sig-decls in these decls
 		-> TcM [Id]
 		
 
 tcInterfaceSigs unf_env decls
   = listTc [ do_one name ty id_infos src_loc
-	   | TyClD (IfaceSig name ty id_infos src_loc) <- decls]
+	   | IfaceSig name ty id_infos src_loc <- decls]
   where
     in_scope_vars = []	-- I think this will be OK
 
@@ -108,7 +108,7 @@ tcWorkerInfo unf_env ty info worker_name
   = uniqSMToTcM (mkWrapper ty arity demands res_bot cpr_info) `thenNF_Tc` \ wrap_fn ->
     let
 	-- Watch out! We can't pull on unf_env too eagerly!
-	info' = case tcLookupRecId unf_env worker_name of
+	info' = case tcLookupRecId_maybe unf_env worker_name of
 		  Just worker_id -> info `setUnfoldingInfo`  mkTopUnfolding (wrap_fn worker_id)
                                          `setWorkerInfo`     HasWorker worker_id arity
 

ghc/compiler/typecheck/TcInstDcls.lhs

@@ -167,11 +167,10 @@ tcInstDecls1 :: PackageInstEnv
 	     -> TcEnv 			-- Contains IdInfo for dfun ids
 	     -> (Name -> Maybe Fixity)	-- for deriving Show and Read
 	     -> Module			-- Module for deriving
-	     -> [TyCon]
 	     -> [RenamedHsDecl]
 	     -> TcM (PackageInstEnv, InstEnv, [InstInfo], RenamedHsBinds)
 
-tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod tycons decls
+tcInstDecls1 inst_env0 prs hst unf_env get_fixity mod decls
   = let
 	inst_decls = [inst_decl | InstD inst_decl <- decls]	
 	tycl_decls = [decl      | TyClD decl <- decls]

ghc/compiler/typecheck/TcModule.lhs

@@ -11,9 +11,11 @@ module TcModule (
 #include "HsVersions.h"
 
 import CmdLineOpts	( DynFlag(..), DynFlags, opt_PprStyle_Debug )
-import HsSyn		( HsBinds(..), MonoBinds(..), HsDecl(..) )
+import HsSyn		( HsBinds(..), MonoBinds(..), HsDecl(..), 
+			  isIfaceRuleDecl, nullBinds, andMonoBindList
+			)
 import HsTypes		( toHsType )
-import RnHsSyn		( RenamedHsDecl, RenamedHsExpr )
+import RnHsSyn		( RenamedHsBinds, RenamedHsDecl, RenamedHsExpr )
 import TcHsSyn		( TypecheckedMonoBinds, TypecheckedHsExpr,
 			  TypecheckedForeignDecl, TypecheckedRuleDecl,
 			  zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet
@@ -24,22 +26,20 @@ import TcMonad
 import TcType		( newTyVarTy )
 import Inst		( plusLIE )
 import TcBinds		( tcTopBinds )
-import TcClassDcl	( tcClassDecls2, mkImplicitClassBinds )
+import TcClassDcl	( tcClassDecls2 )
 import TcDefaults	( tcDefaults )
 import TcExpr		( tcMonoExpr )
 import TcEnv		( TcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv, 
-			  tcEnvTyCons, tcEnvClasses,  isLocalThing,
-			  tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv
+			  isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv