language proposal: ad-hoc overloading

The point of having a strongly typed language is so the compiler can do more work for you. But right now I do a lot of typing (pun not intended) to appease the compiler. Let me give you an example: module Prob where import qualified Data.Map as M ... newtype Prob p a = Prob { runProb :: [(a,p)] } combine :: (Num p, Ord a) => Prob p a -> Prob p a combine m = Prob $ M.assocs $ foldl' (flip $ uncurry $ M.insertWith (+)) M.empty $ runProb m Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments. My proposal is to allow "ad-hoc" overloading of names; if a name is ambiguous in a scope, attempt to type-check the expression against each name. It is only an error if type-checking against all names fails. If type-checking succeeds for more than one then the expression is ambiguous and this is also an error. Pros: shorter code, less busywork to please the compiler Cons: potentially exponential compile time? Any thoughts? -- ryan

Hello Ryan, Sunday, August 31, 2008, 10:21:44 PM, you wrote:
Cons: potentially exponential compile time?
yes, and exponential programming complexity growth, going to brain explosion :) don't forget that OOP languages that supports ad-hoc overloading doesn't allow to infer types in both directions. it seems that we should trade one feature for another -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Am Sonntag, 31. August 2008 20:21 schrieb Ryan Ingram:
The point of having a strongly typed language is so the compiler can do more work for you. But right now I do a lot of typing (pun not intended) to appease the compiler.
Let me give you an example:
module Prob where import qualified Data.Map as M ...
newtype Prob p a = Prob { runProb :: [(a,p)] }
combine :: (Num p, Ord a) => Prob p a -> Prob p a combine m = Prob $ M.assocs $ foldl' (flip $ uncurry $ M.insertWith (+)) M.empty $ runProb m
Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments.
My proposal is to allow "ad-hoc" overloading of names; if a name is ambiguous in a scope, attempt to type-check the expression against each name. It is only an error if type-checking against all names fails. If type-checking succeeds for more than one then the expression is ambiguous and this is also an error.
Pros: shorter code, less busywork to please the compiler Cons: potentially exponential compile time?
Any thoughts?
-- ryan
Another Con is that the compiler can catch fewer programming errors that way. I can't think of a credible example right now, but what if you typo'd a function argument, it typechecks according to the above rules, but with a completely unintended function and your programme outputs garbage (of course, garbage which is not immediately recognisable as such)? Still, I often have the same desire when I forget a qualification :) Cheers, Daniel

On 2008 Aug 31, at 14:58, Daniel Fischer wrote:
Am Sonntag, 31. August 2008 20:21 schrieb Ryan Ingram:
Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments.
Another Con is that the compiler can catch fewer programming errors that way.
If omitting the qualifier doesn't cause this already then I don't think it will be much of a problem (either it won't find what you're looking for or it will be ambiguous). -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

My proposal is to allow "ad-hoc" overloading of names;
+1, although ... this could interact badly with the (still common?) practice of leaving out type declarations. (of course having allowed this in the first place is another language design error :-) when considering language changes (extensions), we should carefully distinguish whether it mainly helps readability or writability - and readability should be the prime concern. e.g. ad-hoc overloading will lead to less typing, but more trouble reading. often, the work of typing can be reduced by tools (e.g. IDEs that know about the names that are currently in scope, and are applicable for a particular type, and can auto-complete them etc.) in the particular case of writing M.* too often, another option would be to have a local "unqualification" of an import. Cf. C++: "using namespace", which can occur in any scope, not just at top (module) level; or Ada: "use". J.W.

Well, I was thinking that way when I was starting learning Haskell. But then I realized that this "feature" would make code much harder to read. Suppose you have different thing all named "insertWith". You've got one somewhere in your program; how do YOU know when looking at the code after a month or so, which one is this? Certainly, given a smart IDE you can ask it; but I think that code should be clear just when you look at it, without any action. What CAN be useful is, IMHO, to make your IDE substitute this "M."s for you when you type. On 31 Aug 2008, at 22:21, Ryan Ingram wrote:
The point of having a strongly typed language is so the compiler can do more work for you. But right now I do a lot of typing (pun not intended) to appease the compiler.
Let me give you an example:
module Prob where import qualified Data.Map as M ...
newtype Prob p a = Prob { runProb :: [(a,p)] }
combine :: (Num p, Ord a) => Prob p a -> Prob p a combine m = Prob $ M.assocs $ foldl' (flip $ uncurry $ M.insertWith (+)) M.empty $ runProb m
Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments.
My proposal is to allow "ad-hoc" overloading of names; if a name is ambiguous in a scope, attempt to type-check the expression against each name. It is only an error if type-checking against all names fails. If type-checking succeeds for more than one then the expression is ambiguous and this is also an error.
Pros: shorter code, less busywork to please the compiler Cons: potentially exponential compile time?
Any thoughts?
-- ryan _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Well, I was thinking that way when I was starting learning Haskell. But then I realized that this "feature" would make code much harder to read. Suppose you have different thing all named "insertWith". You've got one somewhere in your program; how do YOU know when looking at the code after a month or so, which one is this? Certainly, given a smart IDE you can ask it; but I think that code should be clear just when you look at it, without any action.
Indeed. Too much overloading can be a lot of trouble. You can do adhoc overloading already: {-# LANGUAGE FlexibleInstances #-} class Adhoc a where adhoc :: a instance Adhoc ((a->b)->([a]->[b])) where adhoc = map instance Adhoc (Maybe a->a) where adhoc = maybe (error "wrong number") id instance Adhoc [Char] where adhoc = "hello, world" instance Adhoc (String->IO ()) where adhoc = print main :: IO () main = adhoc (adhoc (adhoc . Just :: Char -> Char) (adhoc :: String) :: String) I hope this also demonstrates why it is usually a bad idea, even if it often looks good in theory. If you're not convinced yet, play with this kind of code in practice. The "well-typed programs don't go wrong" of static type checking depends on a clear separation of "right" and "wrong". If your use of types allows anything to be a valid program, minor variations in code will no longer be caught by the type system: at best, you'll get "missing instance", more likely you'll get "too many possibilities", and at worst, the code will simply do something different.
What CAN be useful is, IMHO, to make your IDE substitute this "M."s for you when you type.
haskellmode for Vim does that (though it isn't type aware, so you get a larger menu of possible completions than necessary). Claus [1] http://www.cs.kent.ac.uk/~cr3/toolbox/haskell/Vim/

On Sun, Aug 31, 2008 at 2:10 PM, Claus Reinke
Indeed. Too much overloading can be a lot of trouble.
You can do adhoc overloading already:
{-# LANGUAGE FlexibleInstances #-}
class Adhoc a where adhoc :: a
instance Adhoc ((a->b)->([a]->[b])) where adhoc = map instance Adhoc (Maybe a->a) where adhoc = maybe (error "wrong number") id instance Adhoc [Char] where adhoc = "hello, world" instance Adhoc (String->IO ()) where adhoc = print
Yes, of course taken to this extent it is bad, but I'm not suggesting this at all. In particular, we have well-chosen names for many functions, but not every container can use exact same interface (see, for example, the many discussions on "restricted monads"). So we can't reuse the same function name for similar concepts that have slightly different interfaces.
main :: IO () main = adhoc (adhoc (adhoc . Just :: Char -> Char) (adhoc :: String) :: String)
I hope this also demonstrates why it is usually a bad idea, even if it often looks good in theory. If you're not convinced yet, play with this kind of code in practice.
I do play with this kind of code in practice, in other languages. In practice, I don't see the kind of problems you are bringing up occur. However, those languages tend to be dynamically typed so I do get the occasional runtime type error. I'd much rather have a safe way of doing less typing than an unsafe way. As an example of this done correctly, in Ruby, you have Array#each: [1,2,3].each { |x| print x } Hash#each: { :foo => "hello", :bar => "world" }.each { |k, v| print v } etc. "each" corresponds to the idea of iterating over a container (foldM in Haskell) without being a slave to maintaining an identical API for each type. I maintain that in Haskell, trying to get this same generality often leads to abuse of the typeclass system for things where the types should trivially be determined at compile time.
The "well-typed programs don't go wrong" of static type checking depends on a clear separation of "right" and "wrong". If your use of types allows anything to be a valid program, minor variations in code will no longer be caught by the type system: at best, you'll get "missing instance", more likely you'll get "too many possibilities", and at worst, the code will simply do something different.
I don't think this is a strong argument. In practice most things have a single concrete type and helping the compiler with extra qualified names is just meaningless typing. I'm suggesting that in the case of this code:
import Data.Map as M x = map (+1) M.empty "map" should be inferred as "M.map" instead of being ambiguous.
There's already some minor work in the direction I am suggesting in record syntax, but it only works during pattern matching. I'd like "cx foo + cy foo" to work on any "foo" that has record members cx and cy that are members of Num, instead of needing to preface every record with the datatype name to avoid ambiguity. In particular I do NOT want each function in its own typeclass; the previous post saying:
foo x = map (bar x) should be rejected as ambiguous without a type signature somewhere (at least, if Data.Map is imported). This does give some amount of "action at a distance" where changing a file that is imported by another file can cause previously unambiguous code to become ambiguous, but that is already true! And this modification would make it less likely to be the case.
As to the argument that a "sufficiently smart IDE" would insert the "M." for me, I think that is flawed. First, there isn't a sufficiently smart IDE yet, and second, it'd be better for the type-aware IDE to tell me the types of things when I (for example) mouse over them, instead of helping me type longer things. -- ryan

On Sun, 2008-08-31 at 16:08 -0700, Ryan Ingram wrote:
In particular I do NOT want each function in its own typeclass; the previous post saying:
foo x = map (bar x) should be rejected as ambiguous without a type signature somewhere
What type signature do you propose? It seems as if you're proposing that doubleSet :: Set.Set Int -> Set.Set Int doubleSet = map (*2) doubleList :: [Int] -> [Int] doubleList :: map (*2) work, but that you not be allowed to notice that the definitions are identical and substitute double = map (*2) for both definitions. Sorry, but I use Haskell specifically because I do *not* want to use C ++. jcc

On Sun, Aug 31, 2008 at 4:21 PM, Jonathan Cast
It seems as if you're proposing that
doubleSet :: Set.Set Int -> Set.Set Int doubleSet = map (*2)
doubleList :: [Int] -> [Int] doubleList :: map (*2)
work, but that you not be allowed to notice that the definitions are identical and substitute
double = map (*2)
for both definitions.
Yes, that's exactly what I am suggesting. This is especially important because Set cannot be made an instance of Functor because of the Ord restriction on the elements, so you can't generalize to fmap without redefining Functor as RestrictedFunctor or some such, which adds a ton of additional type-level programming that shouldn't be required for day-to-day work. I'm not against being able to use "double = map (*2)" generally, but the evidence I've seen says that the PL theory isn't there yet to do so without unacceptable performance penalties. (That definition violates the monomorphism restriction anyways).
Sorry, but I use Haskell specifically because I do *not* want to use C++.
I don't think "a language I dislike also has this feature" is a good argument against a feature. C++ also has named fields in records, and a standard I/O library. Should Haskell not have those either? -- ryan

On Sun, 2008-08-31 at 19:06 -0700, Ryan Ingram wrote:
On Sun, Aug 31, 2008 at 4:21 PM, Jonathan Cast
wrote: It seems as if you're proposing that
doubleSet :: Set.Set Int -> Set.Set Int doubleSet = map (*2)
doubleList :: [Int] -> [Int] doubleList :: map (*2)
work, but that you not be allowed to notice that the definitions are identical and substitute
double = map (*2)
for both definitions.
Yes, that's exactly what I am suggesting. This is especially important because Set cannot be made an instance of Functor because of the Ord restriction on the elements, so you can't generalize to fmap without redefining Functor as RestrictedFunctor or some such, which adds a ton of additional type-level programming that shouldn't be required for day-to-day work.
This concept of `day-to-day work' is a curious one. Haskell is not a mature language, and probably shouldn't ever be one. There will always be new discoveries in purely functional programming, and as the art advances, features like this ad-hoc overloading hack (and ACIO) will become obsolete and have to be thrown over-board. I'd rather (much rather!) people concerned with day-to-day programming for writing programs people actually use incorporate Haskell's features into other, more practical, languages (as those who *actually* care about such things are) rather than incorporating features from day-to-day production languages into Haskell.
I'm not against being able to use "double = map (*2)" generally, but the evidence I've seen says that the PL theory isn't there yet to do so without unacceptable performance penalties.
I don't believe in ``unacceptable performance penalties'' as a design criterion for Haskell. This is supposed to be a /research/ language.
(That definition violates the monomorphism restriction anyways).
So?
Sorry, but I use Haskell specifically because I do *not* want to use C++.
I don't think "a language I dislike also has this feature"
How about ``a language I dislike specifically (among other things) because of this `feature' also has this feature'? The great problem with C++ is that ad-hoc overloading allows operators to be defined in an ad-hoc way. In fact, C++ is now adding a feature similar to Haskell's type classes, in an attempt to reign ad-hoc overloading in. I don't thing Haskell should be trying to unreign ad-hoc overloading instead.
is a good argument against a feature. C++ also has named fields in records, and a standard I/O library. Should Haskell not have those either?
Standard I/O libraries are a bad idea, yes, and C++'s implementation of named fields has the same problem --- lack of principle types --- as its ad-hoc overloading. So sure, I'd oppose Haskell introducing either. jcc

As to the argument that a "sufficiently smart IDE" would insert the "M." for me, I think that is flawed. First, there isn't a sufficiently smart IDE yet,
I do believe there will be. What we do now is sort of putting down requirements ...
and second, it'd be better for the type-aware IDE to tell me the types of things when I (for example) mouse over them, instead of helping me type longer things.
That's been said before: an IDE might help in writing/changing code, but code should be readable without tool support. J.W.

Ryan Ingram wrote:
I maintain that in Haskell, trying to get this same generality often leads to abuse of the typeclass system for things where the types should trivially be determined at compile time.
I don't see how that is abuse. The type class system is there for types which can be (more or less) trivially determined at compile time. Tillmann

Miguel Mitrofanov wrote:
Suppose you have different thing all named "insertWith". You've got one somewhere in your program; how do YOU know when looking at the code after a month or so, which one is this?
We already have that situation when classes are involved. If you replace specialised functions by abstractions provided classes, for instance mempty instead of Data.Structure.empty fmap instead of Data.Structure.map folds from Data.Foldable instead of a specialised module There certainly are more examples, but these are the most common. IMHO this doesn't make code much harder to read. mempty gives us some empty data structre, fmap applies a function to all its elements and folds do the same. It doesn't matter if we're talking about lists, sets or something else. And it has the huge advantage that you can replace a data structure by another (Maybe by [], [] by Set, ...) simply by changing a type signature and not the code.
Certainly, given a smart IDE you can ask it; but I think that code should be clear just when you look at it, without any action.
I think that - at least in the examples listed above - the code remains very clear.
[...]
Regards, Stephan -- Früher hieß es ja: Ich denke, also bin ich. Heute weiß man: Es geht auch so. - Dieter Nuhr

Ryan Ingram wrote:
My proposal is to allow "ad-hoc" overloading of names; if a name is ambiguous in a scope, attempt to type-check the expression against each name. It is only an error if type-checking against all names fails. If type-checking succeeds for more than one then the expression is ambiguous and this is also an error.
Pros: shorter code, less busywork to please the compiler Cons: potentially exponential compile time?
Any thoughts?
Now try importing something like Data.Map where almost every single function name clashes with the Prelude. If I write foo x = map (bar x) then unless there are some explicit type signatures somewhere, the poor compiler has no way of knowing whether this function is mapping over a list or a Map. (Arguably you might wish to write a function that does both. This quickly boils down to an argument along the lines of "Haskell doesn't support container neutrality very well", which as I understand it is already a known problem.)

Andrew Coppin
This quickly boils down to an argument along the lines of "Haskell doesn't support container neutrality very well", which as I understand it is already a known problem.
In all fairness, this complaint boils down to "there is no container typeclass" -- a nuisance but not a failure of the language per se. Likewise, there is no typeclass which gathers together the more useful similarities of ByteString and String. -- _jsn

On 2008.08.31 11:21:44 -0700, Ryan Ingram
The point of having a strongly typed language is so the compiler can do more work for you. But right now I do a lot of typing (pun not intended) to appease the compiler.
Let me give you an example:
module Prob where import qualified Data.Map as M
newtype Prob p a = Prob { runProb :: [(a,p)] }
combine :: (Num p, Ord a) => Prob p a -> Prob p a combine m = Prob $ M.assocs $ foldl' (flip $ uncurry $ M.insertWith (+)) M.empty $ runProb m
Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments.
My proposal is to allow "ad-hoc" overloading of names; if a name is ambiguous in a scope, attempt to type-check the expression against each name. It is only an error if type-checking against all names fails. If type-checking succeeds for more than one then the expression is ambiguous and this is also an error.
Pros: shorter code, less busywork to please the compiler Cons: potentially exponential compile time?
Any thoughts?
-- ryan
I think this would be very nice in GHCi, because there the situation is even *worse*. I think we've all experienced importing Data.Map or Data.ByteString and discovering we need to tediously write it out in *full*, because we can't even do qualified imports of it! -- gwern BND fritz FKS 1071 Face government Tomahawk DREO IA O

Gwern Branwen wrote:
I think this would be very nice in GHCi, because there the situation is even *worse*.
I think we've all experienced importing Data.Map or Data.ByteString and discovering we need to tediously write it out in *full*, because we can't even do qualified imports of it!
Amen to that! Data.ByteString.Lazy.pack "Hello " Data.ByteString.Lazy.++ Data.ByteString.Lazy.pack "World!"

Erm... Why can't we? On 1 Sep 2008, at 00:43, Gwern Branwen wrote:
I think we've all experienced importing Data.Map or Data.ByteString and discovering we need to tediously write it out in *full*, because we can't even do qualified imports of it!
-- gwern BND fritz FKS 1071 Face government Tomahawk DREO IA O _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Oh, sorry, haven't noticed you said "ghcI". On 1 Sep 2008, at 00:59, Miguel Mitrofanov wrote:
Erm... Why can't we?
On 1 Sep 2008, at 00:43, Gwern Branwen wrote:
I think we've all experienced importing Data.Map or Data.ByteString and discovering we need to tediously write it out in *full*, because we can't even do qualified imports of it!
-- gwern BND fritz FKS 1071 Face government Tomahawk DREO IA O _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On 2008.09.01 01:01:21 +0400, Miguel Mitrofanov
Oh, sorry, haven't noticed you said "ghcI".
On 1 Sep 2008, at 00:59, Miguel Mitrofanov wrote:
Erm... Why can't we?
The GHC API just doesn't support it. See the bug report filed on this issue: http://hackage.haskell.org/trac/ghc/ticket/1895. (Remember, each cc is like a vote!) -- gwern RX-7 PGP 5.0i ISFR Kosiura Reuters WANK mailbomb Templar NATIA

2008/8/31 Ryan Ingram
My proposal is to allow "ad-hoc" overloading of names; if a name is ambiguous in a scope, attempt to type-check the expression against each name. It is only an error if type-checking against all names fails. If type-checking succeeds for more than one then the expression is ambiguous and this is also an error.
-1, at least for now. Haskell already has one method of overloading: type classes. What you propose is a seemingly innocent extension that I now doubt has extremely far-reaching consequences into the language. Such a feature should be properly researched before it is added to the language. Here's an example of such a concern: you write the following: import Data.Map foo = map What is the type of `foo'? I can think of several solutions to this problem: one that springs to mind is to create something akin to an "on-the-fly" typeclass "class HasMap h where map :: h" and add instances for [a] and Ord k => Map k a. But I suspect there are other options, with differing semantics. What if you further define bar = map (+1), what happens then? Etc. etc. The point I'm trying to make is that such a seemingly simple change is in actual fact not nearly as simple as you might expect. So we should consider carefully how this changes the language, and whether it's worth it. -- -David

On Sun, Aug 31, 2008 at 5:11 PM, David House
Here's an example of such a concern: you write the following:
module Amb where import Data.Map
foo = map
What is the type of `foo'?
Exactly the same as now: it has no type: amb.hs:4:6: Ambiguous occurrence `map' It could refer to either `Prelude.map', imported from Prelude or `Data.Map.map', imported from Data.Map at amb.hs:2:0-14 On the other hand, this module would no longer fail to compile:
module Amb where import Data.Map
foo :: (a -> b) -> [a] -> [b] foo = map
which right now gives the same error message as above, but with my proposal would successfully compile, with foo = Prelude.map. As Philippa said, the naive implementation is: 1) Attempt to typecheck with all permutations of ambiguous names 2a) If zero permutations typecheck, type error. 2b) If multiple permutations typecheck, the program is ambiguous (current behavior) 2c) Otherwise, exactly one typechecks successfully. Specialize the ambiguous names to the chose permutation and continue compilation. It is a conservative extension of the language, because any program that successfully compiles now has no change: there are no ambiguous names in any currently compiling Haskell program. But it accepts some additional programs that have ambiguities, by choosing the only result that typechecks. If there is more than one possible type for foo, the program is still ambiguous and therefore should not compile. -- ryan

On Sun, Aug 31, 2008 at 11:21:44AM -0700, Ryan Ingram wrote:
[..] Any thoughts? -- ryan Nice problem, nice idea.. Maybe the time is better spend on IDEs than extending the (or all) compilers..
Right now I've something like this in my vim script files: function! vl#dev#haskell#qffixfixable#AddMissingExtensions() let addExt='' let alreadyAsked = {} for qfitem in reverse(getqflist()) let match = matchstr(qfitem['text'] \ , '(use -X\zs[^)]*\ze)\|(-X\zs[^ ]*\ze permits this)\|(Use \zs[^ ]*\ze to lift this restriction)' \ .'\|(Use -X\zs[^ ]*\ze to allow operators in types)' \ .'\|(Use -X\zs[^ ]*\ze to suppress this message)' \ .'\|Use -X\zs[^ ]*\ze if you want to disable this' \ .'\|Use -X\zs[^ ]*\ze to permit this' \ .'\|(Use -X\zs[^ ]*\ze to allow multi-parameter classes)' \ .'\|([Uu]se -X\zs[^ ]*\ze)' \ .'\|or use \zs[^ ]*\ze' \ .'\|(Use \zs[^ ]*\ze to permit this)' \ .'\|Use -X\zs[^ ]*\ze to permit it' \ .'\|Use -X\zs[^ ]*\ze if you want to allow more.)' \ ) let replace = { \ '-fno-monomorphism-restriction' : 'NoMonomorphismRestriction' \ , '-fallow-undecidable-instances' : 'UndecidableInstances' \ } let match = get(replace, match, match) if match != '' let addExt = match endif getting many information out of error message asking me wether I want to add the used extension to the {#- LANGUAGE .. #-} pragma. So what about enhancing ghc so that it prints a message such as ============= hs file =============================================== import qualified Data.Set as S import qualified Data.Map as M [..] ============= error message ========================================== file.hs: line col: not in scope foo. Maybe you meant M.empty or S.empty or without qualified file.hs: line col: ambiguous occurence of empty, Maybe you meant M.empty or S.empty then it woulde be easy to ask the editor to do the right thing, give you a choice ? I'd say this is not as perfect as your proposal, but it can be implemented much more easily. Sincerly Marc Weber

Ryan Ingram wrote:
module Prob where import qualified Data.Map as M ....
newtype Prob p a = Prob { runProb :: [(a,p)] }
combine :: (Num p, Ord a) => Prob p a -> Prob p a combine m = Prob $ M.assocs $ foldl' (flip $ uncurry $ M.insertWith (+)) M.empty $ runProb m
Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments.
May I humbly suggest a much simpler solution to your problem: if an identifier is ambiguous, the compiler will use the last import. So, in your example, the compiler will assume that any instance of empty is Data.Map.empty Some means of using an imported module as the default namespace, and requiring the Prelude to be qualified, may also help.

On 2008 Sep 6, at 19:09, John Smith wrote:
Ryan Ingram wrote:
module Prob where import qualified Data.Map as M .... newtype Prob p a = Prob { runProb :: [(a,p)] } combine :: (Num p, Ord a) => Prob p a -> Prob p a combine m = Prob $ M.assocs $ foldl' (flip $ uncurry $ M.insertWith (+)) M.empty $ runProb m Do you see it? All those "M." just seem dirty to me, especially because the compiler should be able to deduce them from the types of the arguments.
May I humbly suggest a much simpler solution to your problem: if an identifier is ambiguous, the compiler will use the last import. So, in your example, the compiler will assume that any instance of empty is Data.Map.empty
I don't like that idea very much; if I reorder my imports the program semantics suddenly change?
Some means of using an imported module as the default namespace, and requiring the Prelude to be qualified, may also help.
You can already do this by importing Prelude explicitly, possibly with the NoImplicitPrelude language option. -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH
participants (16)
-
Andrew Coppin
-
Brandon S. Allbery KF8NH
-
Bulat Ziganshin
-
Claus Reinke
-
Daniel Fischer
-
David House
-
Gwern Branwen
-
Jason Dusek
-
Johannes Waldmann
-
John Smith
-
Jonathan Cast
-
Marc Weber
-
Miguel Mitrofanov
-
Ryan Ingram
-
Stephan Friedrichs
-
Tillmann Rendel