[GHC] #9755: Monomorphism related Ix/Vector error when code is loaded by GHCi/cabal repl

#9755: Monomorphism related Ix/Vector error when code is loaded by GHCi/cabal repl -------------------------------------+------------------------------------- Reporter: bitemyapp | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.3 Keywords: | Operating System: Architecture: Unknown/Multiple | Unknown/Multiple Difficulty: Unknown | Type of failure: Blocked By: | None/Unknown Related Tickets: | Test Case: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- {{{ {-# LANGUAGE BangPatterns #-} import Data.Vector (Vector, (!)) import qualified Data.Vector as Vec import Data.Ix (Ix) import qualified Data.Ix as Ix vecIndexIx :: (Ix ix, Bounded ix) => Vector a -> ix -> a vecIndexIx vec ix = vec ! Ix.index (minBound :: ix, maxBound :: ix) ix vecCreateIx :: (Ix ix, Bounded ix) => (ix -> a) -> Vector a vecCreateIx f = Vec.fromListN (Ix.rangeSize bounds) [ y | ix <- Ix.range bounds, let !y = f ix ] where bounds = (minBound, maxBound) }}} The following errors occur: {{{ GHCi, version 7.8.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Prelude> :l cabal cabal.sandbox.config cabal_problem.hs Prelude> :l cabal_problem.hs [1 of 1] Compiling Main ( cabal_problem.hs, interpreted ) cabal_problem.hs:9:37: Could not deduce (Bounded ix1) arising from a use of ‘minBound’ from the context (Ix ix, Bounded ix) bound by the type signature for vecIndexIx :: (Ix ix, Bounded ix) => Vector a -> ix -> a at cabal_problem.hs:8:16-57 Possible fix: add (Bounded ix1) to the context of an expression type signature: ix1 or the type signature for vecIndexIx :: (Ix ix, Bounded ix) => Vector a -> ix -> a In the expression: minBound :: ix In the first argument of ‘Ix.index’, namely ‘(minBound :: ix, maxBound :: ix)’ In the second argument of ‘(!)’, namely ‘Ix.index (minBound :: ix, maxBound :: ix) ix’ cabal_problem.hs:9:53: Could not deduce (Bounded ix1) arising from a use of ‘maxBound’ from the context (Ix ix, Bounded ix) bound by the type signature for vecIndexIx :: (Ix ix, Bounded ix) => Vector a -> ix -> a at cabal_problem.hs:8:16-57 Possible fix: add (Bounded ix1) to the context of an expression type signature: ix1 or the type signature for vecIndexIx :: (Ix ix, Bounded ix) => Vector a -> ix -> a In the expression: maxBound :: ix In the first argument of ‘Ix.index’, namely ‘(minBound :: ix, maxBound :: ix)’ In the second argument of ‘(!)’, namely ‘Ix.index (minBound :: ix, maxBound :: ix) ix’ cabal_problem.hs:12:32: Could not deduce (Ix a0) arising from a use of ‘Ix.rangeSize’ from the context (Ix ix, Bounded ix) bound by the type signature for vecCreateIx :: (Ix ix, Bounded ix) => (ix -> a) -> Vector a at cabal_problem.hs:11:16-59 The type variable ‘a0’ is ambiguous Note: there are several potential instances: instance Ix () -- Defined in ‘GHC.Arr’ instance (Ix a, Ix b) => Ix (a, b) -- Defined in ‘GHC.Arr’ instance (Ix a1, Ix a2, Ix a3) => Ix (a1, a2, a3) -- Defined in ‘GHC.Arr’ ...plus 8 others In the first argument of ‘Vec.fromListN’, namely ‘(Ix.rangeSize bounds)’ In the expression: Vec.fromListN (Ix.rangeSize bounds) [y | ix <- Ix.range bounds, let !y = f ix] In an equation for ‘vecCreateIx’: vecCreateIx f = Vec.fromListN (Ix.rangeSize bounds) [y | ix <- Ix.range bounds, let !y = f ix] where bounds = (minBound, maxBound) cabal_problem.hs:12:45: Could not deduce (Bounded a0) arising from a use of ‘bounds’ from the context (Ix ix, Bounded ix) bound by the type signature for vecCreateIx :: (Ix ix, Bounded ix) => (ix -> a) -> Vector a at cabal_problem.hs:11:16-59 The type variable ‘a0’ is ambiguous Note: there are several potential instances: instance Bounded Data.Monoid.All -- Defined in ‘Data.Monoid’ instance Bounded Data.Monoid.Any -- Defined in ‘Data.Monoid’ instance Bounded a => Bounded (Data.Monoid.Dual a) -- Defined in ‘Data.Monoid’ ...plus 23 others In the first argument of ‘Ix.rangeSize’, namely ‘bounds’ In the first argument of ‘Vec.fromListN’, namely ‘(Ix.rangeSize bounds)’ In the expression: Vec.fromListN (Ix.rangeSize bounds) [y | ix <- Ix.range bounds, let !y = f ix] Failed, modules loaded: none. }}} The remedy was in this pull request https://github.com/haskell/hackage- server/pull/273/files under the file "Distribution/Server/Features/Search/DocTermIds.hs" -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9755 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9755: Monomorphism related Ix/Vector error when code is loaded by GHCi/cabal repl -------------------------------------+------------------------------------- Reporter: bitemyapp | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.3 Resolution: | Keywords: Operating System: | Architecture: Unknown/Multiple Unknown/Multiple | Difficulty: Unknown Type of failure: | Blocked By: None/Unknown | Related Tickets: Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by rwbarton): Do you have a `.ghci` file with `:set -XNoMonomorphismRestriction` by any chance? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9755#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9755: Monomorphism related Ix/Vector error when code is loaded by GHCi/cabal repl -------------------------------------+------------------------------------- Reporter: bitemyapp | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.3 Resolution: | Keywords: Operating System: | Architecture: Unknown/Multiple Unknown/Multiple | Difficulty: Unknown Type of failure: | Blocked By: None/Unknown | Related Tickets: Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by bitemyapp): @rwbarton - yes. Should this code never work without the monomorphism restriction enabled? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9755#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9755: Monomorphism related Ix/Vector error when code is loaded by GHCi/cabal repl -------------------------------------+------------------------------------- Reporter: bitemyapp | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.3 Resolution: | Keywords: Operating System: | Architecture: Unknown/Multiple Unknown/Multiple | Difficulty: Unknown Type of failure: | Blocked By: None/Unknown | Related Tickets: Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by rwbarton): This code relies on the monomorphism restriction since if `bounds` is generalized, there is nothing determining its type at its use in the subexpression `(Ix.rangeSize bounds)`. What might be confusing is that `:set -XFoo` affects the language extensions used when ''loading'' files in ghci. You probably want to use `:seti` in your `.ghci` file, which affects the language extensions used when evaluating expressions interactively. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9755#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9755: Unhelpful error message when -XScopedTypeVariables is omitted -------------------------------------+------------------------------------- Reporter: bitemyapp | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.8.3 Resolution: | Keywords: Operating System: | Architecture: Unknown/Multiple Unknown/Multiple | Difficulty: Unknown Type of failure: | Blocked By: None/Unknown | Related Tickets: Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by simonpj): I believe that the real problem is that in the definition of {{{ vecIndexIx :: (Ix ix, Bounded ix) => Vector a -> ix -> a vecIndexIx vec ix = vec ! Ix.index (minBound :: ix, maxBound :: ix) ix }}} you probably think that the uses of `ix` in the RHS mean the same `ix` as in the type signature. To achieve that you need `-XScopedTypeVariables` and an explicit `forall`: {{{ vecIndexIx :: forall a ix. (Ix ix, Bounded ix) => Vector a -> ix -> a vecIndexIx vec ix = vec ! Ix.index (minBound :: ix, maxBound :: ix) ix }}} Now it works fine. What you wrote is equivalent to {{{ vecIndexIx vec ix = vec ! Ix.index (minBound :: forall ix. ix, maxBound :: forall ix. ix) ix }}} where the type signature `blah :: ix` is universally quantified to `blah :: forall ix. ix`. It's an easy mistake to make. It might be a good idea if GHC spotted type variables that have the same name as one belonging to an enclosing, but un-scoped, type signature, and suggested this change. If someone wanted to try that, I could advise. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9755#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9755: Unhelpful error message when -XScopedTypeVariables is omitted -------------------------------------+------------------------------------- Reporter: bitemyapp | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.3 (Type checker) | Keywords: Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: | Related Tickets: None/Unknown | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Changes (by thomie): * cc: hvr (removed) * component: GHCi => Compiler (Type checker) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9755#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC