[project @ 1998-03-05 20:20:04 by sof]

Default ambiguous _ccall_ results to (), not the arguments

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

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