λ> :set -package vector
package flags have changed, resetting and loading new packages...
λ>
λ> import Prelude
λ>
λ> import qualified Data.Vector.Storable as VS
λ>
λ> :{
λ|
λ| newtype SomeVector = SomeVector (VS.Vector Int)
λ|
λ| isSameVector :: SomeVector -> SomeVector -> Bool
λ| isSameVector (SomeVector x) (SomeVector y) =
λ| x'offset == y'offset && x'fp == y'fp
λ| where
λ| (x'fp, x'offset, _x'len) = VS.unsafeToForeignPtr x
λ| (y'fp, y'offset, _y'len) = VS.unsafeToForeignPtr y
λ|
λ| :}
λ>
λ> let (v :: VS.Vector Int) = VS.fromList [3,2,5] in isSameVector (SomeVector v) (SomeVector v)
True
λ>
λ>
λ> :set -XMonomorphismRestriction
λ>
λ> let v = VS.fromList [3,2,5] in isSameVector (SomeVector v) (SomeVector v)
True
λ>
λ> :set -XNoMonomorphismRestriction
λ>
λ> let v = VS.fromList [3,2,5] in isSameVector (SomeVector v) (SomeVector v)
False
λ>
```
Further more, my intuition about GHC's type inference here is proved wrong by it, right. But I still think that with a single piece of `let-in` construct, types are better to be inferred as specific as possible, then the result would not be affected by some extension's semantics modification. Here v's type can obviously be inferred to `VS.Vector Int` according to its usage in the `SomeVector` data constructor, I wonder why GHC is not doing this?
Thanks very much for the diagnostic and explanation!
I was wrong in assuming the `in isSameVector (SomeVector v) (SomeVector v)` part is enough to have type of v in `let !v = VS.fromList [3,2,5]` inferred as monomorphic, totally unaware about "NoMonomorphismRestriction" before, I've learned it today :D
On 2021-04-06, at 21:51, Viktor Dukhovni <ietf-dane@dukhovni.org> wrote:
On Tue, Apr 06, 2021 at 07:12:51PM +0800, YueCompl via ghc-devs wrote:
λ> import Control.Monad.ST
λ> import qualified Data.Vector.Storable as VS
λ>
λ> :{
λ|
λ| newtype SomeVector = SomeVector (VS.Vector Int)
λ|
λ| isSameVector :: SomeVector -> SomeVector -> Bool
λ| isSameVector (SomeVector !x) (SomeVector !y) = runST $ do
λ| mx@(VS.MVector !x'offset !x'fp) <- VS.unsafeThaw x
λ| my@(VS.MVector !y'offset !y'fp) <- VS.unsafeThaw y
λ| _ <- VS.unsafeFreeze mx
λ| _ <- VS.unsafeFreeze my
λ| return $ x'offset == y'offset && x'fp == y'fp
λ|
λ| :}
λ>
λ> let !v = VS.fromList [3,2,5] in isSameVector (SomeVector v) (SomeVector v)
False
λ>
λ> let !v = SomeVector (VS.fromList [3,2,5]) in isSameVector v v
True
In GHCi, but not in compiled programs, by default the
`NoMonomorphismRestriction` extension is enabled. If I compile your
code with that restriction, I can reproduce your results (the values are
not shared).
If I either skip the extension, or add an explicit type annotation to
for the vector, then the values are shared.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad.ST
import qualified Data.Vector.Storable as VS
newtype SomeVector = SomeVector (VS.Vector Int)
isSameVector :: SomeVector -> SomeVector -> Bool
isSameVector (SomeVector !x) (SomeVector !y) = runST $ do
mx@(VS.MVector !x'offset !x'fp) <- VS.unsafeThaw x
my@(VS.MVector !y'offset !y'fp) <- VS.unsafeThaw y
_ <- VS.unsafeFreeze mx
_ <- VS.unsafeFreeze my
return $ x'offset == y'offset && x'fp == y'fp
main :: IO ()
main =
let !v = VS.fromList [0..1023] -- :: VS.Vector Int
in print $ isSameVector (SomeVector v) (SomeVector v)
Since newtypes are always strict in their argument, I don't think the
BangPattern does what you'd like it to do, it just makes "main" strict
in v. As defined with `NoMonomorphismRestriction` v is a polymorphic
function, and I guess it is specialised at the call site.
--
Viktor.
_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.orghttp://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs