[project @ 2001-05-22 13:43:14 by simonpj]

-------------------------------------------
	Towards generalising 'foreign' declarations
	-------------------------------------------

This is a first step towards generalising 'foreign' declarations to
handle langauges other than C.  Quite a lot of files are touched,
but nothing has really changed.  Everything should work exactly as
before.

	But please be on your guard for ccall-related bugs.

Main things

Basic data types: ForeignCall.lhs
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* Remove absCSyn/CallConv.lhs

* Add prelude/ForeignCall.lhs.  This defines the ForeignCall
  type and its variants

* Define ForeignCall.Safety to say whether a call is unsafe
  or not (was just a boolean).  Lots of consequential chuffing.

* Remove all CCall stuff from PrimOp, and put it in ForeignCall


Take CCallOp out of the PrimOp type (where it was always a glitch)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* Add IdInfo.FCallId variant to the type IdInfo.GlobalIdDetails,
	along with predicates Id.isFCallId, Id.isFCallId_maybe

* Add StgSyn.StgOp, to sum PrimOp with FCallOp, because it
  *is* useful to sum them together in Stg and AbsC land.  If
  nothing else, it minimises changes.


Also generally rename "CCall" stuff to "FCall" where it's generic
to all foreign calls.

3 files changed, 34 insertions, 38 deletions

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index b6a438e0bf..d9dc5c807a 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.51 2000/12/06 13:19:49 simonmar Exp $
+% $Id: CgCase.lhs,v 1.52 2001/05/22 13:43:15 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -56,7 +56,7 @@ import PrimRep		( getPrimRepSize, retPrimRepSize, PrimRep(..)
 import TyCon		( isEnumerationTyCon, isUnboxedTupleTyCon, tyConPrimRep	)
 import Unique           ( Unique, Uniquable(..), newTagUnique )
 import Maybes		( maybeToBool )
-import Util
+import Util		( only )
 import Outputable
 \end{code}
 
@@ -142,30 +142,32 @@ CoreToStg), so we just change its tag to 'C' (for 'case') to ensure it
 doesn't clash with anything else.
 
 \begin{code}
-cgCase (StgPrimApp op args _)
+cgCase (StgOpApp op args _)
        live_in_whole_case live_in_alts bndr srt (StgAlgAlts (Just tycon) alts deflt)
   | isEnumerationTyCon tycon
   = getArgAmodes args `thenFC` \ arg_amodes ->
 
-    let tag_amode = case op of 
-			TagToEnumOp -> only arg_amodes
-			_ -> CTemp (newTagUnique (getUnique bndr) 'C') IntRep
-
-	closure = CVal (CIndex (CLbl (mkClosureTblLabel tycon) PtrRep) tag_amode PtrRep) PtrRep
-    in
-
     case op of {
-	TagToEnumOp -> nopC;  -- no code!
+	StgPrimOp TagToEnumOp	-- No code!
+	   -> returnFC (only arg_amodes) ;
+
+	_  -> 		-- Perform the operation
+	      let
+		tag_amode = CTemp (newTagUnique (getUnique bndr) 'C') IntRep
+	      in
+	      getVolatileRegs live_in_alts			`thenFC` \ vol_regs ->
+ 	      absC (COpStmt [tag_amode] op arg_amodes vol_regs)	`thenC`
+				-- NB: no liveness arg
+	      returnFC tag_amode
+    }						`thenFC` \ tag_amode ->
 
-	_ -> 	-- Perform the operation
-	       getVolatileRegs live_in_alts     `thenFC` \ vol_regs ->
-
- 	       absC (COpStmt [tag_amode] op
-		 arg_amodes -- note: no liveness arg
-		 vol_regs)
-    } 						`thenC`
+    let
+	closure = CVal (CIndex (CLbl (mkClosureTblLabel tycon) PtrRep) 
+			       tag_amode PtrRep) 
+		       PtrRep
+    in
 
- 	-- bind the default binder if necessary
+ 	-- Bind the default binder if necessary
 	-- The deadness info is set by StgVarInfo
     (if (isDeadBinder bndr)
 	then nopC
@@ -185,9 +187,9 @@ cgCase (StgPrimApp op args _)
 Special case #2: inline PrimOps.
 
 \begin{code}
-cgCase (StgPrimApp op args _) 
+cgCase (StgOpApp op@(StgPrimOp primop) args _) 
        live_in_whole_case live_in_alts bndr srt alts
-  | not (primOpOutOfLine op)
+  | not (primOpOutOfLine primop)
   =
 	-- Get amodes for the arguments and results
     getArgAmodes args			`thenFC` \ arg_amodes ->
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
index a47eb92b50..f4ad2a1c68 100644
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ b/ghc/compiler/codeGen/CgExpr.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.42 2001/03/13 12:50:30 simonmar Exp $
+% $Id: CgExpr.lhs,v 1.43 2001/05/22 13:43:15 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -114,13 +114,13 @@ get in a tail-call position, however, we need to actually perform the
 call, so we treat it as an inline primop.
 
 \begin{code}
-cgExpr (StgPrimApp op@(CCallOp ccall) args res_ty)
+cgExpr (StgOpApp op@(StgFCallOp _ _) args res_ty)
   = primRetUnboxedTuple op args res_ty
 
 -- tagToEnum# is special: we need to pull the constructor out of the table,
 -- and perform an appropriate return.
 
-cgExpr (StgPrimApp TagToEnumOp [arg] res_ty) 
+cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty) 
   = ASSERT(isEnumerationTyCon tycon)
     getArgAmode arg `thenFC` \amode ->
 	-- save the tag in a temporary in case amode overlaps
@@ -145,14 +145,16 @@ cgExpr (StgPrimApp TagToEnumOp [arg] res_ty)
 	tycon = tyConAppTyCon res_ty
 
 
-cgExpr x@(StgPrimApp op args res_ty)
-  | primOpOutOfLine op = tailCallPrimOp op args
+cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
+  | primOpOutOfLine primop 
+  = tailCallPrimOp primop args
+
   | otherwise
-  = ASSERT(op /= SeqOp) -- can't handle SeqOp
+  = ASSERT(primop /= SeqOp) -- can't handle SeqOp
 
     getArgAmodes args	`thenFC` \ arg_amodes ->
 
-    case (getPrimOpResultInfo op) of
+    case (getPrimOpResultInfo primop) of
 
 	ReturnsPrim kind ->
 	    let result_amode = CReg (dataReturnConvPrim kind) in
@@ -446,7 +448,7 @@ Little helper for primitives that return unboxed tuples.
 
 
 \begin{code}
-primRetUnboxedTuple :: PrimOp -> [StgArg] -> Type -> Code
+primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
 primRetUnboxedTuple op args res_ty
   = getArgAmodes args	    `thenFC` \ arg_amodes ->
     {-
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
index 467f44b036..2801d453ee 100644
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ b/ghc/compiler/codeGen/ClosureInfo.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: ClosureInfo.lhs,v 1.46 2001/03/13 12:50:30 simonmar Exp $
+% $Id: ClosureInfo.lhs,v 1.47 2001/05/22 13:43:15 simonpj Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
@@ -84,7 +84,6 @@ import DataCon		( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
 			  isNullaryDataCon, dataConName
 			)
 import TyCon		( isBoxedTupleTyCon )
-import IdInfo		( ArityInfo(..) )
 import Name		( Name, nameUnique, getOccName )
 import OccName		( occNameUserString )
 import PprType		( getTyDescription )
@@ -910,13 +909,6 @@ isToplevClosure (MkClosureInfo _ lf_info _)
       other -> False
 \end{code}
 
-\begin{code}
-isLetNoEscape :: ClosureInfo -> Bool
-
-isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
-isLetNoEscape _ = False
-\end{code}
-
 Label generation.
 
 \begin{code}