From: sof <unknown>
Date: Mon, 26 May 1997 01:39:55 +0000 (+0000)
Subject: [project @ 1997-05-26 01:39:55 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~559
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e8b278dfdb2d9f0fbdddcb6119c8cf8caefa8d2a;p=ghc-hetmet.git

[project @ 1997-05-26 01:39:55 by sof]
Updated to use defn. of IdInfo.StrictnessInfo (worker id *plus* constructors mentioned, need this so that eventually the renamer is given enough info on what data types to import concretely
---

diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index 5ce8b51..a34a061 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -31,7 +31,7 @@ import WwLib		( mkWrapper )
 import SpecEnv		( SpecEnv )
 import PrimOp		( PrimOp(..) )
 
-import Id		( GenId, mkImported, mkUserId, 
+import Id		( GenId, mkImported, mkUserId, addInlinePragma,
 			  isPrimitiveId_maybe, dataConArgTys, SYN_IE(Id) )
 import Type		( mkSynTy, getAppDataTyConExpandingDicts )
 import TyVar		( mkTyVar )
@@ -42,15 +42,10 @@ import PragmaInfo	( PragmaInfo(..) )
 import ErrUtils		( pprBagOfErrors )
 import Maybes		( maybeToBool )
 import Pretty
-import PprStyle		( PprStyle(..) )
+import Outputable	( Outputable(..), PprStyle(..) )
 import Util		( zipWithEqual, panic, pprTrace, pprPanic )
 
 import IdInfo
-
-#if __GLASGOW_HASKELL__ >= 202
-import Outputable
-#endif
-
 \end{code}
 
 Ultimately, type signatures in interfaces will have pragmatic
@@ -70,7 +65,12 @@ tcInterfaceSigs (SigD (IfaceSig name ty id_infos src_loc) : rest)
     tcHsType ty					`thenTc` \ sigma_ty ->
     tcIdInfo name sigma_ty noIdInfo id_infos	`thenTc` \ id_info' ->
     let
-	sig_id = mkImported name sigma_ty id_info'
+	imp_id = mkImported name sigma_ty id_info'
+	sig_id | any inline_please id_infos = addInlinePragma imp_id
+	       | otherwise	 	    = imp_id
+
+	inline_please (HsUnfold inline _) = inline
+	inline_please other		  = False
     in
     tcInterfaceSigs rest		`thenTc` \ sig_ids ->
     returnTc (sig_id : sig_ids)
@@ -98,7 +98,7 @@ tcIdInfo name ty info (HsArgUsage au : rest)
 tcIdInfo name ty info (HsDeforest df : rest)
   = tcIdInfo name ty (info `addDeforestInfo` df) rest
 
-tcIdInfo name ty info (HsUnfold expr : rest)
+tcIdInfo name ty info (HsUnfold inline expr : rest)
   = tcUnfolding name expr 	`thenNF_Tc` \ unfold_info ->
     tcIdInfo name ty (info `addUnfoldInfo` unfold_info) rest
 
@@ -114,8 +114,8 @@ tcStrictness ty info (StrictnessInfo demands maybe_worker)
     let
 	-- Watch out! We can't pull on maybe_worker_id too eagerly!
 	info' = case maybe_worker_id of
-			Just worker_id -> info `addUnfoldInfo` mkUnfolding NoPragmaInfo (wrap_fn worker_id)
-			Nothing        -> info
+			Just (worker_id,_) -> info `addUnfoldInfo` mkUnfolding NoPragmaInfo (wrap_fn worker_id)
+			Nothing            -> info
     in
     returnTc (info' `addStrictnessInfo` StrictnessInfo demands maybe_worker_id)
 
@@ -129,13 +129,13 @@ tcStrictness ty info NoStrictnessInfo
 \begin{code}
 tcWorker Nothing = returnNF_Tc Nothing
 
-tcWorker (Just worker_name)
+tcWorker (Just (worker_name,_))
   = tcLookupGlobalValueMaybe worker_name	`thenNF_Tc` \ maybe_worker_id ->
     returnNF_Tc (trace_maybe maybe_worker_id)
   where
 	-- The trace is so we can see what's getting dropped
     trace_maybe Nothing  = pprTrace "tcWorker failed:" (ppr PprDebug worker_name) Nothing
-    trace_maybe (Just x) = Just x
+    trace_maybe (Just x) = Just (x, [])
 \end{code}
 
 For unfoldings we try to do the job lazily, so that we never type check