From: sof <unknown>
Date: Thu, 5 Mar 1998 20:20:15 +0000 (+0000)
Subject: [project @ 1998-03-05 20:20:04 by sof]
X-Git-Tag: Approx_2487_patches~886
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=475562175b5000ed7da8d8a7883365469fc91cae;p=ghc-hetmet.git

[project @ 1998-03-05 20:20:04 by sof]
Default ambiguous _ccall_ results to (), not the arguments
---

diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index c289fe3..12b983f 100644
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -33,7 +33,7 @@ module PrelInfo (
 	main_NAME, allClass_NAME, ioTyCon_NAME,
 
 	needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass,
-	isNumericClass, isStandardClass, isCcallishClass
+	isNumericClass, isStandardClass, isCcallishClass, isCreturnableClass
     ) where
 
 #include "HsVersions.h"
@@ -499,12 +499,14 @@ even though every numeric class has these two as a superclass,
 because the list of ambiguous dictionaries hasn't been simplified.
 
 \begin{code}
-isCcallishClass, isNoDictClass, isNumericClass, isStandardClass :: Class -> Bool
-
-isNumericClass   clas = classKey clas `is_elem` numericClassKeys
-isStandardClass  clas = classKey clas `is_elem` standardClassKeys
-isCcallishClass	 clas = classKey clas `is_elem` cCallishClassKeys
-isNoDictClass    clas = classKey clas `is_elem` noDictClassKeys
+isCcallishClass, isCreturnableClass, isNoDictClass, 
+isNumericClass, isStandardClass :: Class -> Bool
+
+isNumericClass     clas = classKey clas `is_elem` numericClassKeys
+isStandardClass    clas = classKey clas `is_elem` standardClassKeys
+isCcallishClass	   clas = classKey clas `is_elem` cCallishClassKeys
+isCreturnableClass clas = classKey clas == cReturnableClassKey
+isNoDictClass      clas = classKey clas `is_elem` noDictClassKeys
 is_elem = isIn "is_X_Class"
 
 numericClassKeys
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 2cd1458..3645145 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -146,7 +146,7 @@ import Id		( mkIdSet )
 
 import Bag		( Bag, bagToList, snocBag )
 import Class		( Class, ClassInstEnv, classBigSig, classInstEnv )
-import PrelInfo		( isNumericClass, isCcallishClass )
+import PrelInfo		( isNumericClass, isCreturnableClass )
 
 import Maybes		( maybeToBool )
 import Type		( Type, ThetaType, TauType, mkTyVarTy, getTyVar,
@@ -925,9 +925,9 @@ disambigGroup dicts
     ASSERT( null frees && null ambigs )
     returnTc binds
 
-  | all isCcallishClass classes
+  | all isCreturnableClass classes
   = 	-- Default CCall stuff to (); we don't even both to check that () is an 
-	-- instance of CCallable/CReturnable, because we know it is.
+	-- instance of CReturnable, because we know it is.
     unifyTauTy (mkTyVarTy tyvar) unitTy    `thenTc_`
     returnTc EmptyMonoBinds