) where
-import Ubiq
+IMP_Ubiq()
-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, mEnvToList )
+import MatchEnv ( nullMEnv, isEmptyMEnv, mEnvToList )
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"
-isUnboxedDataType = panic "IdInfo.isUnboxedDataType"
-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}
-- 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}
will in turn @apply_to_IdInfo@ of the self-same @IdInfo@. (A very
nasty loop, friends...)
\begin{code}
-apply_to_IdInfo ty_fn (IdInfo arity demand spec strictness unfold
+apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold
update deforest arg_usage fb_ww srcloc)
+ | isEmptyMEnv spec
+ = idinfo
+ | otherwise
= panic "IdInfo:apply_to_IdInfo"
{- LATER:
let
= 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}
%************************************************************************
-> 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'
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, "")]
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"
\begin{code}
mkUnfolding guide expr
- = GenForm False (mkFormSummary NoStrictnessInfo expr)
- (BSCC("OccurExpr") occurAnalyseGlobalExpr expr ESCC)
+ = GenForm (mkFormSummary NoStrictnessInfo expr)
+ (occurAnalyseGlobalExpr expr)
guide
\end{code}
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
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
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