+
+
+%************************************************************************
+%* *
+\section[Disambig]{Disambiguation of overloading}
+%* *
+%************************************************************************
+
+
+If a dictionary constrains a type variable which is
+\begin{itemize}
+\item
+not mentioned in the environment
+\item
+and not mentioned in the type of the expression
+\end{itemize}
+then it is ambiguous. No further information will arise to instantiate
+the type variable; nor will it be generalised and turned into an extra
+parameter to a function.
+
+It is an error for this to occur, except that Haskell provided for
+certain rules to be applied in the special case of numeric types.
+
+Specifically, if
+\begin{itemize}
+\item
+at least one of its classes is a numeric class, and
+\item
+all of its classes are numeric or standard
+\end{itemize}
+then the type variable can be defaulted to the first type in the
+default-type list which is an instance of all the offending classes.
+
+So here is the function which does the work. It takes the ambiguous
+dictionaries and either resolves them (producing bindings) or
+complains. It works by splitting the dictionary list by type
+variable, and using @disambigOne@ to do the real business.
+
+IMPORTANT: @disambiguate@ assumes that its argument dictionaries
+constrain only a simple type variable.
+
+\begin{code}
+type SimpleDictInfo s = (Inst s, Class, TcTyVar s)
+
+disambiguateDicts :: LIE s -> TcM s ()
+
+disambiguateDicts insts
+ = mapTc disambigOne inst_infos `thenTc` \ binds_lists ->
+ returnTc ()
+ where
+ inst_infos = equivClasses cmp_tyvars (map mk_inst_info (bagToList insts))
+ (_,_,tv1) `cmp_tyvars` (_,_,tv2) = tv1 `cmp` tv2
+
+ mk_inst_info dict@(Dict _ clas ty _ _)
+ = (dict, clas, getTyVar "disambiguateDicts" ty)
+\end{code}
+
+@disambigOne@ assumes that its arguments dictionaries constrain all
+the same type variable.
+
+ADR Comment 20/6/94: I've changed the @CReturnable@ case to default to
+@()@ instead of @Int@. I reckon this is the Right Thing to do since
+the most common use of defaulting is code like:
+\begin{verbatim}
+ _ccall_ foo `seqPrimIO` bar
+\end{verbatim}
+Since we're not using the result of @foo@, the result if (presumably)
+@void@.
+
+\begin{code}
+disambigOne :: [SimpleDictInfo s] -> TcM s ()
+
+disambigOne dict_infos
+ | not (isStandardNumericDefaultable classes)
+ = failTc (ambigErr dicts) -- no default
+
+ | otherwise -- isStandardNumericDefaultable dict_infos
+ = -- THE DICTS OBEY THE DEFAULTABLE CONSTRAINT
+ -- SO, TRY DEFAULT TYPES IN ORDER
+
+ -- Failure here is caused by there being no type in the
+ -- default list which can satisfy all the ambiguous classes.
+ -- For example, if Real a is reqd, but the only type in the
+ -- default list is Int.
+ tcGetDefaultTys `thenNF_Tc` \ default_tys ->
+ let
+ try_default [] -- No defaults work, so fail
+ = failTc (defaultErr dicts default_tys)
+
+ try_default (default_ty : default_tys)
+ = tryTc (try_default default_tys) $ -- If default_ty fails, we try
+ -- default_tys instead
+ tcSimplifyCheckThetas thetas `thenTc` \ _ ->
+ returnTc default_ty
+ where
+ thetas = classes `zip` repeat default_ty
+ in
+ -- See if any default works, and if so bind the type variable to it
+ try_default default_tys `thenTc` \ chosen_default_ty ->
+ tcInstType [] chosen_default_ty `thenNF_Tc` \ chosen_default_tc_ty -> -- Tiresome!
+ unifyTauTy chosen_default_tc_ty (mkTyVarTy tyvar)
+
+ where
+ (_,_,tyvar) = head dict_infos -- Should be non-empty
+ dicts = [dict | (dict,_,_) <- dict_infos]
+ classes = [clas | (_,clas,_) <- dict_infos]
+
+\end{code}
+
+@isStandardNumericDefaultable@ sees whether the dicts have the
+property required for defaulting; namely at least one is numeric, and
+all are standard; or all are CcallIsh.
+
+\begin{code}
+isStandardNumericDefaultable :: [Class] -> Bool
+
+isStandardNumericDefaultable classes
+ = --pprTrace "isStdNumeric:\n" (ppAboves [ppCat (map (ppr PprDebug) classes), ppCat (map (ppr PprDebug . isNumericClass) classes), ppCat (map (ppr PprDebug . isStandardClass) classes), ppCat (map (ppr PprDebug . isCcallishClass) classes)]) $
+ (any isNumericClass classes && all isStandardClass classes)
+ || (all isCcallishClass classes)
+\end{code}
+
+
+
+Errors and contexts
+~~~~~~~~~~~~~~~~~~~
+ToDo: for these error messages, should we note the location as coming
+from the insts, or just whatever seems to be around in the monad just
+now?
+
+\begin{code}
+genCantGenErr insts sty -- Can't generalise these Insts
+ = ppHang (ppStr "Cannot generalise these overloadings (in a _ccall_):")
+ 4 (ppAboves (map (ppr sty) (bagToList insts)))
+\end{code}
+
+\begin{code}
+ambigErr insts sty
+ = ppAboves (map (pprInst sty "Ambiguous overloading") insts)
+\end{code}
+
+@reduceErr@ complains if we can't express required dictionaries in
+terms of the signature.
+
+\begin{code}
+reduceErr insts sty
+ = ppAboves (map (pprInst sty "Context required by inferred type, but missing on a type signature")
+ (bagToList insts))
+\end{code}
+
+\begin{code}
+defaultErr dicts defaulting_tys sty
+ = ppHang (ppStr "Ambiguously-overloaded types could not be resolved:")
+ 4 (ppAboves [
+ ppHang (ppStr "Conflicting:")
+ 4 (ppInterleave ppSemi (map (pprInst sty ""{-???-}) dicts)),
+ ppHang (ppStr "Defaulting types :")
+ 4 (ppr sty defaulting_tys),
+ ppStr "([Int, Double] is the default list of defaulting types.)" ])
+\end{code}
+