import TyCon ( TyCon, isSynTyCon )
import Type ( splitDFunTy, isTyVarTy,
splitTyConApp_maybe, splitDictTy,
- splitAlgTyConApp_maybe, splitForAllTys,
- unUsgTy, tyVarsOfTypes, mkClassPred, mkTyVarTy,
+ splitForAllTys,
+ tyVarsOfTypes, mkClassPred, mkTyVarTy,
getClassTys_maybe
)
import Subst ( mkTopTyVarSubst, substClasses )
= plusAssoc_C AndMonoBinds (getGenericBinds m1) (getGenericBinds m2)
getGenericBinds (FunMonoBind id infixop matches loc)
- = mapAssoc wrap (foldr add emptyAssoc matches)
+ = mapAssoc wrap (foldl add emptyAssoc matches)
+ -- Using foldl not foldr is vital, else
+ -- we reverse the order of the bindings!
where
- add match env = case maybeGenericMatch match of
+ add env match = case maybeGenericMatch match of
Nothing -> env
Just (ty, match') -> extendAssoc_C (++) env (ty, [match'])
-- emit an error message. This in turn means that we don't
-- mention the constructor, which doesn't exist for CCallable, CReturnable
-- Hardly beautiful, but only three extra lines.
- HsApp (TyApp (HsVar eRROR_ID) [(unUsgTy . idType) this_dict_id])
+ HsApp (TyApp (HsVar eRROR_ID) [idType this_dict_id])
(HsLit (HsString msg))
| otherwise -- The common case
maybe_tycon_app = splitTyConApp_maybe first_inst_tau
Just (tycon, arg_tys) = maybe_tycon_app
- -- Stuff for an *algebraic* data type
- alg_tycon_app_maybe = splitAlgTyConApp_maybe first_inst_tau
- -- The "Alg" part looks through synonyms
- Just (alg_tycon, _, _) = alg_tycon_app_maybe
-
ccallable_type dflags ty = isFFIArgumentTy dflags False {- Not safe call -} ty
creturnable_type ty = isFFIResultTy ty
\end{code}