From: ken <unknown>
Date: Thu, 6 Sep 2001 21:08:16 +0000 (+0000)
Subject: [project @ 2001-09-06 21:08:16 by ken]
X-Git-Tag: Approximately_9120_patches~1016
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5d5f7c6ce359f5c10b1f2312e295c4f5c235ec88;p=ghc-hetmet.git

[project @ 2001-09-06 21:08:16 by ken]
Fix the code to *really* do the following:

On the Alpha we can only handle <= 4 integer arguments with foreign export
dynamic.  Following the example of the corresponding Sparc hack, we detect
when we're being asked to do something we can't and refuse.

MERGE TO STABLE BRANCH
---

diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
index ab0961e..b13dec3 100644
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -34,7 +34,7 @@ import Inst		( emptyLIE, LIE, plusLIE )
 import ErrUtils		( Message )
 import Id		( Id, mkLocalId )
 import Name		( nameOccName )
-import PrimRep		( getPrimRepSize )
+import PrimRep		( getPrimRepSize, isFloatingRep )
 import Type		( typePrimRep )
 import TcType		( Type, tcSplitFunTys, tcSplitTyConApp_maybe, tcSplitForAllTys,
 			  isFFIArgumentTy, isFFIImportResultTy, 
@@ -166,8 +166,9 @@ checkFEDArgs arg_tys
 checkFEDArgs arg_tys
   = check (integral_args <= 4) err
   where
-    integral_args = sum (map (getPrimRepSize . filter (not . isFloatingRep)
-                                             . typePrimRep) arg_tys)
+    integral_args = sum (map getPrimRepSize $
+                         filter (not . isFloatingRep) $
+                         map typePrimRep arg_tys)
     err = ptext SLIT("On Alpha, I can only handle 4 non-floating-point arguments to foreign export dynamic")
 #else
 checkFEDArgs arg_tys = returnNF_Tc ()