X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=f6afdc1c91ef37d2584ad9bd4be8e9961e014873;hb=26741ec416bae2c502ef00a2ba0e79050a32cb67;hp=8f35f6af71ecf4118bcfeef571e9f26e773065e6;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 8f35f6a..f6afdc1 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -30,7 +30,7 @@ module IdInfo (
 	mkDemandInfo,
 	willBeDemanded,
 
-	MatchEnv,		-- the SpecEnv
+	MatchEnv,		-- the SpecEnv (why is this exported???)
 	StrictnessInfo(..), 	-- non-abstract
 	Demand(..),	    	-- non-abstract
 
@@ -47,14 +47,14 @@ module IdInfo (
 
 	UpdateInfo,
 	mkUpdateInfo,
-	UpdateSpec(..),
+	SYN_IE(UpdateSpec),
 	updateInfoMaybe,
 
 	DeforestInfo(..),
 
 	ArgUsageInfo,
 	ArgUsage(..),
-	ArgUsageType(..),
+	SYN_IE(ArgUsageType),
 	mkArgUsageInfo,
 	getArgUsage,
 
@@ -67,28 +67,31 @@ module IdInfo (
 
     ) where
 
-import Ubiq
+IMP_Ubiq()
+IMPORT_1_3(Char(toLower))
 
-import IdLoop		-- IdInfo is a dependency-loop ranch, and
+IMPORT_DELOOPER(IdLoop)	-- IdInfo is a dependency-loop ranch, and
 			-- we break those loops by using IdLoop and
 			-- *not* importing much of anything else,
 			-- except from the very general "utils".
 
 import CmdLineOpts	( opt_OmitInterfacePragmas )
 import Maybes		( firstJust )
-import MatchEnv		( nullMEnv, isEmptyMEnv, mEnvToList )
+import MatchEnv		( nullMEnv, isEmptyMEnv, mEnvToList, MatchEnv )
 import Outputable	( ifPprInterface, Outputable(..){-instances-} )
 import PprStyle		( PprStyle(..) )
 import Pretty
 import SrcLoc		( mkUnknownSrcLoc )
-import Type		( eqSimpleTy )
+import Type		( eqSimpleTy, splitFunTyExpandingDicts )
 import Util		( mapAccumL, panic, assertPanic, pprPanic )
 
+#ifdef REALLY_HASKELL_1_3
+ord = fromEnum :: Char -> Int
+#endif
+
 applySubstToTy = panic "IdInfo.applySubstToTy"
-splitTypeWithDictsAsArgs = panic "IdInfo.splitTypeWithDictsAsArgs"
 showTypeCategory = panic "IdInfo.showTypeCategory"
 mkFormSummary = panic "IdInfo.mkFormSummary"
-occurAnalyseGlobalExpr = panic "IdInfo.occurAnalyseGlobalExpr"
 isWrapperFor = panic "IdInfo.isWrapperFor"
 pprCoreUnfolding = panic "IdInfo.pprCoreUnfolding"
 \end{code}
@@ -138,7 +141,7 @@ data IdInfo
 	-- ToDo: SrcLoc is in FullNames too (could rm?)  but it
 	-- is needed here too for things like ConstMethodIds and the
 	-- like, which don't have full-names of their own Mind you,
-	-- perhaps the FullName for a constant method could give the
+	-- perhaps the Name for a constant method could give the
 	-- class/type involved?
 \end{code}
 
@@ -422,7 +425,7 @@ instance OptIdInfo (MatchEnv [Type] CoreExpr) where
       = ppSpecs sty True better_id_fn nullIdEnv (mEnvToList spec)
 
 ppSpecs sty print_spec_id_info better_id_fn inline_env spec_env
-  = panic "IdInfo:ppSpecs"
+  = if null spec_env then ppNil else panic "IdInfo:ppSpecs"
 \end{code}
 
 %************************************************************************
@@ -563,7 +566,7 @@ or an Absent {\em that we accept}.
 indicatesWorker :: [Demand] -> Bool
 
 indicatesWorker dems
-  = fake_mk_ww (_trace "mAX_WORKER_ARGS" 6 - nonAbsentArgs dems) dems
+  = fake_mk_ww (trace "mAX_WORKER_ARGS" 6 - nonAbsentArgs dems) dems
   where
     fake_mk_ww _ [] = False
     fake_mk_ww _ (WwLazy True : _) = True -- we accepted an Absent
@@ -583,9 +586,8 @@ mkWrapperArgTypeCategories
 	-> String	-- a string saying lots about the args
 
 mkWrapperArgTypeCategories wrapper_ty wrap_info
-  = case (splitTypeWithDictsAsArgs wrapper_ty) of { (_,arg_tys,_) ->
-    map do_one (wrap_info `zip` (map showTypeCategory arg_tys))
-    }
+  = case (splitFunTyExpandingDicts wrapper_ty) of { (arg_tys,_) ->
+    map do_one (wrap_info `zip` (map showTypeCategory arg_tys)) }
   where
     -- ToDo: this needs FIXING UP (it was a hack anyway...)
     do_one (WwPrim, _) = 'P'
@@ -609,7 +611,11 @@ as the worker requires.  Hence we have to give up altogether, and call
 the wrapper only; so under these circumstances we return \tr{False}.
 
 \begin{code}
+#ifdef REALLY_HASKELL_1_3
+instance Read Demand where
+#else
 instance Text Demand where
+#endif
     readList str = read_em [{-acc-}] str
       where
 	read_em acc []		= [(reverse acc, "")]
@@ -628,6 +634,9 @@ instance Text Demand where
 
 	read_em acc other = panic ("IdInfo.readem:"++other)
 
+#ifdef REALLY_HASKELL_1_3
+instance Show Demand where
+#endif
     showList wrap_args rest = (concat (map show1 wrap_args)) ++ rest
       where
 	show1 (WwLazy False) = "L"
@@ -727,8 +736,8 @@ pp_strictness sty for_this_id_maybe better_id_fn inline_env
 
 \begin{code}
 mkUnfolding guide expr
-  = GenForm False (mkFormSummary NoStrictnessInfo expr)
-	(BSCC("OccurExpr") occurAnalyseGlobalExpr expr ESCC)
+  = GenForm (mkFormSummary NoStrictnessInfo expr)
+	(occurAnalyseGlobalExpr expr)
 	guide
 \end{code}
 
@@ -737,8 +746,8 @@ noInfo_UF = NoUnfoldingDetails
 
 getInfo_UF (IdInfo _ _ _ _ unfolding _ _ _ _ _)
   = case unfolding of
-      GenForm _ _ _ BadUnfolding -> NoUnfoldingDetails
-      unfolding_as_was 		     -> unfolding_as_was
+      GenForm _ _ BadUnfolding -> NoUnfoldingDetails
+      unfolding_as_was 	       -> unfolding_as_was
 
 -- getInfo_UF ensures that any BadUnfoldings are never returned
 -- We had to delay the test required in TcPragmas until now due
@@ -759,9 +768,9 @@ pp_unfolding sty for_this_id inline_env uf_details
     pp (MagicForm tag _)
       = ppCat [ppPStr SLIT("_MF_"), ppPStr tag]
 
-    pp (GenForm _ _ _ BadUnfolding) = pp_NONE
+    pp (GenForm _ _ BadUnfolding) = pp_NONE
 
-    pp (GenForm _ _ template guide)
+    pp (GenForm _ template guide)
       = let
 	    untagged = unTagBinders template
 	in
@@ -800,7 +809,11 @@ updateInfoMaybe (SomeUpdateInfo	 u) = Just u
 Text instance so that the update annotations can be read in.
 
 \begin{code}
+#ifdef REALLY_HASKELL_1_3
+instance Read UpdateInfo where
+#else
 instance Text UpdateInfo where
+#endif
     readsPrec p s | null s    = panic "IdInfo: empty update pragma?!"
 		  | otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
       where