Why are these record accesses ambiguous

Hi Haskell Cafe, In the following code, I get an error saying Ambiguous occurrence `x'. Why can't Haskell work out which x to call based on the type of getA? Thanks -John #!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show x xx
---------------------- module A where data TypeA = TypeA { a :: Int , x :: Int } getA = TypeA { a = 1, x = 2 } ------------------------- module B where data TypeB = TypeB { b :: Int , x :: Int } getB = TypeB { b = 1, x = 3 } -------------------------- ./test.lhs:8:21: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at ./test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at ./test.lhs:4:2-9 (defined at B.hs:5:5)

Probably because you don't apply "x" to "xx" anywhere? On 6 Jun 2009, at 11:48, John Ky wrote:
Hi Haskell Cafe,
In the following code, I get an error saying Ambiguous occurrence `x'. Why can't Haskell work out which x to call based on the type of getA?
Thanks
-John
#!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show x xx
----------------------
module A where
data TypeA = TypeA { a :: Int , x :: Int }
getA = TypeA { a = 1, x = 2 }
-------------------------
module B where
data TypeB = TypeB { b :: Int , x :: Int }
getB = TypeB { b = 1, x = 3 }
--------------------------
./test.lhs:8:21: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at ./test.lhs: 3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at ./test.lhs: 4:2-9 (defined at B.hs:5:5)
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Sat, Jun 6, 2009 at 1:48 AM, John Ky
Hi Haskell Cafe,
In the following code, I get an error saying Ambiguous occurrence `x'. Why can't Haskell work out which x to call based on the type of getA?
Thanks
-John
#!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show x xx
This is parsed as two arguments passed to the show function (which only takes one argument). putStrLn $ show (x xx) Or because putStrLn . show = print; print $ x xx
----------------------
module A where
data TypeA = TypeA { a :: Int , x :: Int }
getA = TypeA { a = 1, x = 2 }
-------------------------
module B where
data TypeB = TypeB { b :: Int , x :: Int }
getB = TypeB { b = 1, x = 3 }
--------------------------
./test.lhs:8:21: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at ./test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at ./test.lhs:4:2-9 (defined at B.hs:5:5)
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi Luke, You're right. My code had a typo. Unfortunately, I still get the same error whichever way I do it. For example:
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA print (x xx)
and: #!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show (x xx)
both give me:
test.lhs:8:22:
Ambiguous occurrence `x'
It could refer to either `A.x', imported from A at test.lhs:3:2-9
(defined at A.hs:5:5)
or `B.x', imported from B at test.lhs:4:2-9
(defined at B.hs:5:5)
Any ideas?
$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 6.10.3
Thanks,
-John
On Sat, Jun 6, 2009 at 6:41 PM, Luke Palmer
On Sat, Jun 6, 2009 at 1:48 AM, John Ky
wrote: Hi Haskell Cafe,
In the following code, I get an error saying Ambiguous occurrence `x'. Why can't Haskell work out which x to call based on the type of getA?
Thanks
-John
#!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show x xx
This is parsed as two arguments passed to the show function (which only takes one argument).
putStrLn $ show (x xx)
Or because putStrLn . show = print;
print $ x xx
----------------------
module A where
data TypeA = TypeA { a :: Int , x :: Int }
getA = TypeA { a = 1, x = 2 }
-------------------------
module B where
data TypeB = TypeB { b :: Int , x :: Int }
getB = TypeB { b = 1, x = 3 }
--------------------------
./test.lhs:8:21: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at ./test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at ./test.lhs:4:2-9 (defined at B.hs:5:5)
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

The error is because of the way records work in Haskell. Recall that a record is just sugar for the normal datatype syntax. Namely: data FooA a b c = FooA {getA :: a, getB:: b, getC :: c} can be accessed as either f (FooA a b c) = ... or f fooA = ... (getA fooA) ... etc That is, Record syntax just creates functions for each label that take a record and return the content of that label. eg getA :: FooA a b c -> a getA (FooA a _ _ ) = a ... So when you have two records with the same label in it: data Bar = Bar { badlabel :: Int } data Baz = Baz { badlabel :: String } even though they are not the same type, you end up with the following definitions: badlabel :: Bar -> Int badlabel :: Baz -> String this is a type error, one that is not trivially resolved. Thats where your problem is coming from, two fields both named `x` which result in this error. HTH, /Joe John Ky wrote:
Hi Luke,
You're right. My code had a typo. Unfortunately, I still get the same error whichever way I do it.
For example:
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA print (x xx)
and:
#!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show (x xx)
both give me:
test.lhs:8:22: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at test.lhs:4:2-9 (defined at B.hs:5:5)
Any ideas?
$ ghc --version The Glorious Glasgow Haskell Compilation System, version 6.10.3
Thanks,
-John
On Sat, Jun 6, 2009 at 6:41 PM, Luke Palmer
mailto:lrpalmer@gmail.com> wrote: On Sat, Jun 6, 2009 at 1:48 AM, John Ky
mailto:newhoggy@gmail.com> wrote: Hi Haskell Cafe,
In the following code, I get an error saying Ambiguous occurrence `x'. Why can't Haskell work out which x to call based on the type of getA?
Thanks
-John
#!/usr/bin/env runhaskell
> {-# LANGUAGE DisambiguateRecordFields #-} > import A > import B > > main = do > let xx = getA > putStrLn $ show x xx
This is parsed as two arguments passed to the show function (which only takes one argument).
putStrLn $ show (x xx)
Or because putStrLn . show = print;
print $ x xx
----------------------
module A where
data TypeA = TypeA { a :: Int , x :: Int }
getA = TypeA { a = 1, x = 2 }
-------------------------
module B where
data TypeB = TypeB { b :: Int , x :: Int }
getB = TypeB { b = 1, x = 3 }
--------------------------
./test.lhs:8:21: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at ./test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at ./test.lhs:4:2-9 (defined at B.hs:5:5)
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org mailto:Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
------------------------------------------------------------------------
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi John, The record field disambiguation only works if you use the form
C{ field-name = variable }
where C is a datatype constructor. In your example you have to write
let TypeA{ x = v } = getA print v
You're right, after type inference it is clear (for us) that x should mean A.x, but this kind of reasoning (disambiguate names based on the results of type inference) is not supported by ghc - and that's a good thing, in my opinion, as otherwise it would be incredibly hard to find the definition in scope. There was a long thread on cafe on this subject. cheers, benedikt John Ky schrieb:
Hi Luke,
You're right. My code had a typo. Unfortunately, I still get the same error whichever way I do it.
For example:
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA print (x xx)
and:
#!/usr/bin/env runhaskell
{-# LANGUAGE DisambiguateRecordFields #-} import A import B
main = do let xx = getA putStrLn $ show (x xx)
both give me:
test.lhs:8:22: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at test.lhs:4:2-9 (defined at B.hs:5:5)
Any ideas?
$ ghc --version The Glorious Glasgow Haskell Compilation System, version 6.10.3
Thanks,
-John
On Sat, Jun 6, 2009 at 6:41 PM, Luke Palmer
mailto:lrpalmer@gmail.com> wrote: On Sat, Jun 6, 2009 at 1:48 AM, John Ky
mailto:newhoggy@gmail.com> wrote: Hi Haskell Cafe,
In the following code, I get an error saying Ambiguous occurrence `x'. Why can't Haskell work out which x to call based on the type of getA?
Thanks
-John
#!/usr/bin/env runhaskell
> {-# LANGUAGE DisambiguateRecordFields #-} > import A > import B > > main = do > let xx = getA > putStrLn $ show x xx
This is parsed as two arguments passed to the show function (which only takes one argument).
putStrLn $ show (x xx)
Or because putStrLn . show = print;
print $ x xx
----------------------
module A where
data TypeA = TypeA { a :: Int , x :: Int }
getA = TypeA { a = 1, x = 2 }
-------------------------
module B where
data TypeB = TypeB { b :: Int , x :: Int }
getB = TypeB { b = 1, x = 3 }
--------------------------
./test.lhs:8:21: Ambiguous occurrence `x' It could refer to either `A.x', imported from A at ./test.lhs:3:2-9 (defined at A.hs:5:5) or `B.x', imported from B at ./test.lhs:4:2-9 (defined at B.hs:5:5)
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org mailto:Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
------------------------------------------------------------------------
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (5)
-
Benedikt Huber
-
Joe Fredette
-
John Ky
-
Luke Palmer
-
Miguel Mitrofanov