[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 (file)
--- 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 (file)
--- 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