I'm trying to understand why one version of this code compiles, and one version does not.
{-# LANGUAGE RankNTypes, FlexibleContexts #-}
module Foo where
import Data.Vector.Generic.Mutable as M
import Data.Vector.Generic as V
import Control.Monad.ST
import Control.Monad.Primitive
data DimFun v m r =
DimFun {dim::Int, func :: v (PrimState m) r -> m ()}
runFun1 :: (Vector v r, MVector (Mutable v) r) =>
(forall m . (PrimMonad m) => DimFun (Mutable v) m r) -> v r -> v r
runFun1 (DimFun dim t) x | V.length x == dim = runST $ do
y <- thaw x
t y
unsafeFreeze y
runFun2 :: (Vector v r, MVector (Mutable v) r) =>
(forall m . (PrimMonad m) => DimFun (Mutable v) m r) -> v r -> v r
runFun2 t x = runST $ do
y <- thaw x
evalFun t y
unsafeFreeze y
evalFun :: (PrimMonad m, MVector v r) => DimFun v m r -> v (PrimState m) r -> m ()
evalFun (DimFun dim f) y | dim == M.length y = f y
runFun2 compiles fine (GHC-7.8.2), but runFun1 results in errors:
Could not deduce (PrimMonad m0) arising from a pattern
from the context (Vector v r, MVector (Mutable v) r)
bound by the type signature for
tfb :: (Vector v r, MVector (Mutable v) r) =>
(forall (m :: * -> *). PrimMonad m => TensorFunc m r) -> v r -> v r
at Testing/Foo.hs:(26,8)-(28,15)
The type variable ‘m0’ is ambiguous
Note: there are several potential instances:
instance PrimMonad IO -- Defined in ‘Control.Monad.Primitive’
instance PrimMonad (ST s) -- Defined in ‘Control.Monad.Primitive’
In the pattern: TensorFunc _ f
In an equation for ‘tfb’:
tfb (TensorFunc _ f) x
= runST
$ do { y <- thaw x;
f y;
unsafeFreeze y }
Couldn't match type ‘m0’ with ‘ST s’
because type variable ‘s’ would escape its scope
This (rigid, skolem) type variable is bound by
a type expected by the context: ST s (v r)
at Testing/Foo.hs:(29,26)-(32,18)
Expected type: ST s ()
Actual type: m0 ()
Relevant bindings include
y :: Mutable v s r (bound at Testing/Foo.hs:30:3)
f :: forall (v :: * -> * -> *).
MVector v r =>
v (PrimState m0) r -> m0 ()
(bound at Testing/Foo.hs:29:19)
In a stmt of a 'do' block: f y
In the second argument of ‘($)’, namely
‘do { y <- thaw x;
f y;
unsafeFreeze y }’
Could not deduce (s ~ PrimState m0)
from the context (Vector v r, MVector (Mutable v) r)
bound by the type signature for
tfb :: (Vector v r, MVector (Mutable v) r) =>
(forall (m :: * -> *). PrimMonad m => TensorFunc m r) -> v r -> v r
at Testing/Foo.hs:(26,8)-(28,15)
‘s’ is a rigid type variable bound by
a type expected by the context: ST s (v r) at Testing/Foo.hs:29:26
Expected type: Mutable v (PrimState m0) r
Actual type: Mutable v s r
Relevant bindings include
y :: Mutable v s r (bound at Testing/Foo.hs:30:3)
f :: forall (v :: * -> * -> *).
MVector v r =>
v (PrimState m0) r -> m0 ()
(bound at Testing/Foo.hs:29:19)
In the first argument of ‘f’, namely ‘y’
In a stmt of a 'do' block: f y
I'm pretty sure the rank-2 type is to blame, possibly caused by a monomorphism restriction. However, as suggested in a previous question of mine, I enabled -XNoMonomorphismRestriction, but got the same error.
What is the difference between these seemingly identical code snippets?
I think that having a rough mental model of the type-level plumbing involved here is essential, so I'm going go talk about "implicit things" in a bit more detail, and scrutinize your problem only after that. Readers only interested in the direct solution to the question may skip to the "Pattern matching on polymorhpic values" subsection and the end.
1. Implicit function arguments
Type arguments
GHC compiles Haskell to a small intermediate language called Core, which is essentially a rank-n polymorphic typed lambda calculus called System F (plus some extensions). Below I am going use Haskell alongside a notation somewhat resembling Core; I hope it's not overly confusing.
In Core, polymorphic functions are functions which take types as additional arguments, and arguments further down the line can refer to those types or have those types:
-- in Haskell
const :: forall (a :: *) (b :: *). a -> b -> a
const x y = x
-- in pseudo-Core
const' :: (a :: *) -> (b :: *) -> a -> b -> a
const' a b x y = x
This means that we must also supply type arguments to these functions whenever we want to use them. In Haskell type inference usually figures out the type arguments and supplies them automatically, but if we look at the Core output (for example, see this introduction for how to do that), type arguments and applications are visible everywhere. Building a mental model of this makes figuring out higher-rank code a whole lot easier:
-- Haskell
poly :: (forall a. a -> a) -> b -> (Int, b)
poly f x = (f 0, f x)
-- pseudo-Core
poly' :: (b :: *) -> ((a :: *) -> a -> a) -> b -> (Int, b)
poly' b f x = (f Int 0, f b x)
And it makes clear why some things don't typecheck:
wrong :: (a -> a) -> (Int, Bool)
wrong f = (f 0, f True)
wrong' :: (a :: *) -> (a -> a) -> (Int, Bool)
wrong' a f = (f ?, f ?) -- f takes an "a", not Int or Bool.
Class constraint arguments
-- Haskell
show :: forall a. Show a => a -> String
show x = show x
-- pseudo-Core
show' :: (a :: *) -> Show a -> a -> String
show' a (ShowDict showa) x = showa x
What is ShowDict and Show a here? ShowDict is just a Haskell record containing a show instance, and GHC generates such records for each instance of a class. Show a is just the type of this instance record:
-- We translate classes to a record type:
class Show a where show :: a -> string
data Show a = ShowDict (show :: a -> String)
-- And translate instances to concrete records of the class type:
instance Show () where show () = "()"
showUnit :: Show ()
showUnit = ShowDict (\() -> "()")
For example, whenever we want to apply show, the compiler has to search the scope in order to find a suitable type argument and an instance dictionary for that type. Note that while instances are always top level, quite often in polymorphic functions the instances are passed in as arguments:
data Foo = Foo
-- instance Show Foo where show _ = "Foo"
showFoo :: Show Foo
showFoo = ShowDict (\_ -> "Foo")
-- The compiler fills in an instance from top level
fooStr :: String
fooStr = show' Foo showFoo Foo
polyShow :: (Show a, Show b) => a -> b -> String
polyShow a b = show a ++ show b
-- Here we get the instances as arguments (also, note how (++) also takes an extra
-- type argument, since (++) :: forall a. [a] -> [a] -> [a])
polyShow' :: (a :: *) -> (b :: *) -> Show a -> Show b -> a -> b -> String
polyShow' a b (ShowDict showa) (ShowDict showb) a b -> (++) Char (showa a) (showb b)
Pattern matching on polymorphic values
In Haskell, pattern matching on functions doesn't make sense. Polymorphic values can be also viewed as functions, but we can pattern match on them, just like in OP's erroneous runfun1 example. However, all the implicit arguments must be inferable in the scope, or else the mere act of pattern matching is a type error:
import Data.Monoid
-- it's a type error even if we don't use "a" or "n".
-- foo :: (forall a. Monoid a => (a, Int)) -> Int
-- foo (a, n) = 0
foo :: ((a :: *) -> Monoid a -> (a, Int)) -> Int
foo f = ? -- What are we going to apply f to?
In other words, by pattern matching on a polymorphic value, we assert that all implicit arguments have been already applied. In the case of foo here, although there isn't a syntax for type application in Haskell, we can sprinkle around type annotations:
{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}
foo :: (forall a. Monoid a => (a, Int)) -> Int
foo x = case (x :: (String, Int)) of (_, n) -> n
-- or alternatively
foo ((_ :: String), n) = n
Again, pseudo-Core makes the situation clearer:
foo :: ((a :: *) -> Monoid a -> (a, Int)) -> Int
foo f = case f String monoidString of (_ , n) -> n
Here monoidString is some available Monoid instance of String.
2. Implicit data fields
Implicit data fields usually correspond to the notion of "existential types" in Haskell. In a sense, they are dual to implicit function arguments with respect to term obligations:
When we construct functions, the implicit arguments are available in the function body.
When we apply functions, we have extra obligations to fulfill.
When we construct data with implicit fields, we must supply those extra fields.
When we pattern match on data, the implicit fields also come into scope.
Standard example:
{-# LANGUAGE GADTs #-}
data Showy where
Showy :: forall a. Show a => a -> Showy
-- pseudo-Core
data Showy where
Showy :: (a :: *) -> Show a -> a -> Showy
-- when constructing "Showy", "Show a" must be also available:
someShowy :: Showy
someShowy = Showy (300 :: Int)
-- in pseudo-Core
someShowy' = Showy Int showInt 300
-- When pattern matching on "Showy", we get an instance in scope too
showShowy :: Showy -> String
showShowy (Showy x) = show x
showShowy' :: Showy -> String
showShowy' (Showy a showa x) = showa x
3. Taking a look at OP's example
We have the function
runFun1 :: (Vector v r, MVector (Mutable v) r) =>
(forall m . (PrimMonad m) => DimFun (Mutable v) m r) -> v r -> v r
runFun1 dfun#(DimFun dim t) x | V.length x == dim = runST $ do
y <- thaw x
t y
unsafeFreeze y
Remember that pattern matching on polymorphic values asserts that all implicit arguments are available in the scope. Except that here, at the point of pattern matching there is no m at all in scope, let alone a PrimMonad instance for it.
With GHC 7.8.x it's is good practice to use type holes liberally:
runFun1 :: (Vector v r, MVector (Mutable v) r) =>
(forall m . (PrimMonad m) => DimFun (Mutable v) m r) -> v r -> v r
runFun1 (DimFun dim t) x | V.length x == dim = _
Now GHC will duly display the type of the hole, and also the types of the variables in the context. We can see that t has type Mutable v (PrimState m0) r -> m0 (), and we also see that m0 is not listed as bound anywhere. Indeed, it is a notorious "ambiguous" type variable conjured up by GHC as a placeholder.
So, why don't we try manually supplying the arguments, just as in the prior example with the Monoid instance? We know that we will use t inside an ST action, so we can try fixing m as ST s and GHC automatically applies the PrimMonad instance for us:
runFun1 :: forall v r. (Vector v r, MVector (Mutable v) r) =>
(forall m . (PrimMonad m) => DimFun (Mutable v) m r) -> v r -> v r
runFun1 (DimFun dim (t :: Mutable v s r -> ST s ())) x
| V.length x == dim = runST $ do
y <- thaw x
t y
unsafeFreeze y
... except it doesn't work and we get the error "Couldn't match type ‘s’ with ‘s1’ because type variable ‘s1’ would escape its scope".
It turns out - comes as no surprise - that we've forgotten about yet another implicit argument. Recall the type of runST:
runST :: (forall s. ST s a) -> a
We can imagine that runST takes a function of type ((s :: PrimState ST) -> ST s a), and then our code looks like this:
runST $ \s -> do
y <- thaw x -- y :: Mutable v s r
t y -- error: "t" takes a "Mutable v s r" with a different "s".
unsafeFreeze y
The s in t's argument type is silently introduced at the outermost scope:
runFun1 :: forall v s r. ...
And thus the two s-es are distinct.
A possible solution is to pattern match on the DimFun argument inside the ST action. There, the correct s is in scope, and GHC can supply ST s as m:
runFun1 :: forall v r. (Vector v r, MVector (Mutable v) r) =>
(forall m . PrimMonad m => DimFun (Mutable v) m r) -> v r -> v r
runFun1 dimfun x = runST $ do
y <- thaw x
case dimfun of
DimFun dim t | dim == M.length y -> t y
unsafeFreeze y
With some parameters made explicit:
runST $ \s -> do
y <- thaw x
case dimfun (ST s) primMonadST of
DimFun dim t | dim == M.length y -> t y
unsafeFreeze y
As an exercise, let's convert all of the function to pseudo-Core (but let's not desugar the do syntax, because that would be way too ugly):
-- the full types of the functions involved, for reference
thaw :: forall m v a. (PrimMonad m, V.Vector v a) => v a -> m (V.Mutable v (PrimState m) a)
runST :: forall a. (forall s. ST s a) -> a
unsafeFreeze :: forall m v a. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a
M.length :: forall v s a. MVector v s a -> Int
(==) :: forall a. Eq a => a -> a -> Bool
runFun1 ::
(v :: * -> *) -> (r :: *)
-> Vector v r -> MVector (Mutable v) r
-> ((m :: (* -> *)) -> PrimMonad m -> DimFun (Mutable v) m r)
-> v r -> v r
runFun1 v r vecInstance mvecInstance dimfun x = runST r $ \s -> do
y <- thaw (ST s) v r primMonadST vecInstance x
case dimFun (ST s) primMonadST of
DimFun dim t | (==) Int eqInt dim (M.length v s r y) -> t y
unsafeFreeze (ST s) v r primMonadST vecInstance y
That was a mouthful.
Now we are well-equipped to explain why runFun2 worked:
runFun2 :: (Vector v r, MVector (Mutable v) r) =>
(forall m . (PrimMonad m) => DimFun (Mutable v) m r) -> v r -> v r
runFun2 t x = runST $ do
y <- thaw x
evalFun t y
unsafeFreeze y
evalFun :: (PrimMonad m, MVector v r) => DimFun v m r -> v (PrimState m) r -> m ()
evalFun (DimFun dim f) y | dim == M.length y = f y
evalFun is just a polymorphic function that gets called in the right place (we ultimately pattern match on t in the right place), where the correct ST s is available as the m argument.
As a type system gets more sophisticated, pattern matching becomes a progressively more serious affair, with far-reaching consequences and non-trivial requirements. At the end of the spectrum you find full-dependent languages and proof assistants such as Agda, Idris or Coq, where pattern matching on a piece of data can mean accepting an arbitrary logical proposition as true in a certain branch of your program.
Though #AndrasKovacs gave a great answer, I think it is worth pointing out how to avoid this nastiness altogether. This answer to a related question by me shows how the "correct" definition for DimFun makes all of the rank-2 stuff go away.
By defining DimFun as
data DimFun v r =
DimFun {dim::Int, func :: forall s . (PrimMonad s) => v (PrimState s) r -> s ()}
runFun1 becomes:
runFun1 :: (Vector v r)
=> DimFun (Mutable v) r -> v r -> v r
runFun1 (DimFun dim t) x | dim == V.length x = runST $ do
y <- thaw x
t y
unsafeFreeze y
and compiles without issue.
Pattern-match on a constrained value is not allowed, I think. In particular, you could use a pattern-match, but only for a GADT constructor that fixed the type(s) in the constraint and choose a specific instance. Otherwise, I get the ambiguous type variable error.
That is, I don't think that GHC can unify the type of a value matching the pattern (DimFun dim t) with the type (forall m . (PrimMonad m) => DimFun (Mutable v) m r).
Note that the pattern match in evalFun looks similar, but it is allowed to put constraints on m since the quantification is scoped over the whole evalFun; in constrast, runFun1 as a smaller scope for the quantification of m.
HTH
Related
In the program below test₁ will not compile but test₂ will. The reason seems to be because of the forall s. in withModulus₁. It seems that the s is a different type for each and every call to withModulus₁ because of the forall s.. Why is that the case?
{-# LANGUAGE
GADTs
, KindSignatures
, RankNTypes
, TupleSections
, ViewPatterns #-}
module Main where
import Data.Reflection
newtype Modulus :: * -> * -> * where
Modulus :: a -> Modulus s a
deriving (Eq, Show)
newtype M :: * -> * -> * where
M :: a -> M s a
deriving (Eq, Show)
add :: Integral a => Modulus s a -> M s a -> M s a -> M s a
add (Modulus m) (M a) (M b) = M (mod (a + b) m)
mul :: Integral a => Modulus s a -> M s a -> M s a -> M s a
mul (Modulus m) (M a) (M b) = M (mod (a * b) m)
unM :: M s a -> a
unM (M a) = a
withModulus₁ :: a -> (forall s. Modulus s a -> w) -> w
withModulus₁ m k = k (Modulus m)
withModulus₂ :: a -> (Modulus s a -> w) -> w
withModulus₂ m k = k (Modulus m)
test₁ = withModulus₁ 89 (\m ->
withModulus₁ 7 (\m' ->
let
a = M 131
b = M 127
in
unM $ add m' (mul m a a) (mul m b b)))
test₂ = withModulus₂ 89 (\m ->
withModulus₂ 7 (\m' ->
let
a = M 131
b = M 127
in
unM $ add m' (mul m a a) (mul m b b)))
Here is the error message:
Modulus.hs:41:29: error:
• Couldn't match type ‘s’ with ‘s1’
‘s’ is a rigid type variable bound by
a type expected by the context:
forall s. Modulus s Integer -> Integer
at app/Modulus.hs:(35,9)-(41,52)
‘s1’ is a rigid type variable bound by
a type expected by the context:
forall s1. Modulus s1 Integer -> Integer
at app/Modulus.hs:(36,11)-(41,51)
Expected type: M s1 Integer
Actual type: M s Integer
• In the second argument of ‘add’, namely ‘(mul m a a)’
In the second argument of ‘($)’, namely
‘add m' (mul m a a) (mul m b b)’
In the expression: unM $ add m' (mul m a a) (mul m b b)
• Relevant bindings include
m' :: Modulus s1 Integer (bound at app/Modulus.hs:36:28)
m :: Modulus s Integer (bound at app/Modulus.hs:35:27)
|
41 | unM $ add m' (mul m a a) (mul m b b)))
| ^^^^^^^^^
Briefly put, a function
foo :: forall s . T s -> U s
lets its caller to choose what the type s is. Indeed, it works on all types s. By comparison,
bar :: (forall s . T s) -> U
requires that its caller provides an argument x :: forall s. T s, i.e. a polymorphic value that will work on all types s. This means that bar will choose what the type s will be.
For instance,
foo :: forall a. a -> [a]
foo x = [x,x,x]
is obvious. Instead,
bar :: (forall a. a->a) -> Bool
bar x = x 12 > length (x "hello")
is more subtle. Here, bar first uses x choosing a ~ Int for x 12, and then uses x again choosing a ~ String for x "hello".
Another example:
bar2 :: Int -> (forall a. a->a) -> Bool
bar2 n x | n > 10 = x 12 > 5
| otherwise = length (x "hello") > 7
Here a is chosen to be Int or String depending on n > 10.
Your own type
withModulus₁ :: a -> (forall s. Modulus s a -> w) -> w
states that withModulus₁ must be allowed to choose s to any type it wishes. When calling this as
withModulus₁ arg (\m -> ...)
m will have type Modulus s0 a where a was chosen by the caller, while s was chosen by withModulus₁ itself. It is required that ... must be compatible with any choice withModulus₁ may take.
What if we nest calls?
withModulus₁ arg (\m1 -> ...
withModulus₁ arg (\m2 -> ...)
...
)
Now, m1 :: Modulus s0 a as before. Further m2 :: Modulus s1 a where s1 is chosen by the innermost call to withModulus₁.
The crucial point, here, is that there is no guarantee that s0 is chosen to be the same as s1. Each call might make a different choice: see e.g. bar2 above which indeed does so.
Hence, the compiler can not assume that s0 and s1 are equal. Hence, if we call a function that requires their equality, like add, we get a type error, since this would constrain the freedom of choice of s by the two withModulus₁ calls.
Which is the Curry-Howard correspondent of double negation of a; (a -> r) -> r or (a -> ⊥) -> ⊥, or both?
Both types can be encoded in Haskell as follows, where ⊥ is encoded as forall b. b.
p1 :: forall r. ((a -> r) -> r)
p2 :: (a -> (forall b. b)) -> (forall b. b)
Paper by Wadler 2003 as well as
implementation in Haskell seem to adopt the former, while some
other literature (e.g. this) seems to support the latter.
My current understanding is that the latter is correct. I have difficulty in understanding the former style, since you can create a value of type a from forall r. ((a -> r) -> r) using pure computation:
> let p1 = ($42) :: forall r. (Int -> r) -> r
> p1 id
42
which seems to contradict with intuitionistic logic that you cannot derive a from ¬¬a.
So, my question is: can p1 and p2 both be regarded as Curry-Howard correspondent of ¬¬a ? If so, how does the fact that we can construct p1 id :: a interact with the intuitionistic logic?
I have come up with clearer encoding of conversion to/from double negation, for convenience of discussion. Thanks to #user2407038 !
{-# LANGUAGE RankNTypes #-}
to_double_neg :: forall a. a -> (forall r. (a->r)->r)
to_double_neg x = ($x)
from_double_neg :: forall a. (forall r. (a->r)->r) -> a
from_double_neg x = x id
To construct a value of type T1 a = forall r . (a -> r) -> r is at least as demanding as construction of a value of type T2 a = (a -> Void) -> Void for, say, Void ~ forall a . a. This can be pretty easily seen because if we can construct a value of type T1 a then we automatically have a value at type T2 a by merely instantiating the forall with Void.
On the other hand, if we have a value of type T2 a we cannot go back. The following appears about right
dne :: forall a . ((a -> Void) -> Void) -> (forall r . (a -> r) -> r)
dne t2 = \f -> absurd (t2 (_ f)) -- we cannot fill _
but the hole _ :: (a -> r) -> (a -> Void) cannot be filled—we both "know" nothing about r in this context and we know we cannot construct a Void.
Here's another important difference: T1 a -> a is fairly trivial to encode, we instantiate the forall with a and then apply id
project :: T1 a -> a
project t1 = t1 id
But, on the other hand, we cannot do this for T2 a
projectX :: T2 a -> a
projectX t2 = absurd (t2 (_ :: a -> Void))
or, at least we cannot without cheating our intuitionistic logic.
So, together these ought to give us a hint as to which of T1 and T2 is genuine double negation and why each is used. To be clear, T2 is genuinely double negation---just like you expect---but T1 is easier to deal with... especially if you work with Haskell98 which lacks nullary data types and higher rank types. Without these, the only "valid" encoding of Void is
newtype Void = Void Void
absurd :: Void -> a
absurd (Void v) = absurd v
which might not be the best thing to introduce if you don't need it. So what ensures that we can use T1 instead? Well, as long as we only ever consider code which is not allowed to instantiate r with a specific type variable then we are, in effect, acting as though it is an abstract or existential type with no operations. This is sufficient for handling many arguments pertaining to double negation (or continuations) and so it might be simpler to just talk about the properties of forall r . (a -> r) -> r rather than (a -> Void) -> Void so long as you maintain a proper discipline which allows you to convert the former to the latter if genuinely needed.
You are correct that (a -> r) -> r is a correct encoding of double negation according to the Curry-Howard isomorphism. However, the type of your function does not fit that type! The following:
double_neg :: forall a r . ((a -> r) -> r)
double_neg = (($42) :: (Int -> r) -> r )
gives a type error:
Couldn't match type `a' with `Int'
`a' is a rigid type variable bound by
the type signature for double_neg :: (a -> r) -> r at test.hs:20:22
Expected type: (a -> r) -> r
Actual type: (Int -> r) -> r
Relevant bindings include
double_neg :: (a -> r) -> r (bound at test.hs:21:1)
More detail: It doesn't matter how you encode bottom. A short demo in agda can help show this. Assuming only one axiom - namely ex falso quodlibet, literally "from false anything follows".
record Double-Neg : Set₁ where
field
⊥ : Set
absurd : {A : Set} → ⊥ → A
¬_ : Set → Set
¬ A = A → ⊥
{-# NO_TERMINATION_CHECK #-}
double-neg : { P : Set } → ¬ (¬ P) → P
double-neg f = absurd r where r = f (λ _ → r)
Note you cannot write a valid definition of double-neg without turning off the termination checker (which is cheating!). If you try your definition again, you also get a type error:
data ⊤ : Set where t : ⊤
double-neg : { P : Set } → ¬ (¬ P) → P
double-neg {P} f = f t
gives
⊤ !=< (P → ⊥)
when checking that the expression t has type ¬ P
Here !=< means "is not a subtype of".
To summarize, the approach p2/T2 is more disciplined, but we cannot compute any practical value out of it. On the other hand p1/T1 allows to instantiate r, but the instantiation is necessary to perform runCont :: Cont r a -> (a -> r) -> r or runContT and get any result and side effect out of it.
However, we can emulate p2/T2 within Control.Monad.Cont , by instantiating r to Void, and by using only the side effect, as follows:
{-# LANGUAGE RankNTypes #-}
import Control.Monad.Cont
import Control.Monad.Trans (lift)
import Control.Monad.Writer
newtype Bottom = Bottom { unleash :: forall a. a}
type C = ContT Bottom
type M = C (Writer String)
data USD1G = USD1G deriving Show
say x = lift $ tell $ x ++ "\n"
runM :: M a -> String
runM m = execWriter $
runContT m (const $ return undefined) >> return ()
-- Are we sure that (undefined :: Bottom) above will never be used?
exmid :: M (Either USD1G (USD1G -> M Bottom))
exmid = callCC f
where
f k = return (Right (\x -> k (Left x)))
useTheWish :: Either USD1G (USD1G -> M Bottom) -> M ()
useTheWish e = case e of
Left money -> say $ "I got money:" ++ show money
Right method -> do
say "I will pay devil the money."
unobtainium <- method USD1G
say $ "I am now omnipotent! The answer to everything is:"
++ show (unleash unobtainium :: Integer)
theStory :: String
theStory = runM $ exmid >>= useTheWish
main :: IO ()
main = putStrLn theStory
{-
> runhaskell bottom-encoding-monad.hs
I will pay devil the money.
I got money:USD1G
-}
If we want to further get rid of the ugly undefined :: Bottom , I think I need to avoid re-invention and use the CPS libraries such as conduits and machines. An example using machines is as follows:
{-# LANGUAGE RankNTypes, ImpredicativeTypes, ScopedTypeVariables #-}
import Data.Machine
import Data.Void
import Unsafe.Coerce
type M k a = Plan k String a
type PT k m a = PlanT k String m a
data USD = USD1G deriving (Show)
type Contract k m = Either USD (USD -> PT k m Void)
callCC :: forall a m k. ((a -> PT k m Void) -> PT k m a) -> PT k m a
callCC f = PlanT $
\ kp ke kr kf ->
runPlanT (f (\x -> PlanT $ \_ _ _ _ -> unsafeCoerce $kp x))
kp ke kr kf
exmid :: PT k m (Contract k m)
exmid = callCC f
where
f k =
return $ Right (\x -> k (Left x))
planA :: Contract k m -> PT k m ()
planA e = case e of
Left money ->
yield $ "I got money: " ++ show money
Right method -> do
yield $ "I pay devil the money"
u <- method USD1G
yield $ "The answer to everything is :" ++ show (absurd u :: Integer)
helloMachine :: Monad m => SourceT m String
helloMachine = construct $ exmid >>= planA
main :: IO ()
main = do
xs <- runT helloMachine
print xs
Thanks to our conversation, now I have better understanding of the type signature of runPlanT .
While iterating my code towards a correct version, I came across the following curiosity:
{-# LANGUAGE RankNTypes #-}
module Foo where
import Data.Vector.Generic.Mutable as M
import Control.Monad.Primitive
-- an in-place vector function with dimension
data DimFun v m r =
DimFun Int (v (PrimState m) r -> m ())
eval :: (PrimMonad m, MVector v r) => DimFun v m r -> v (PrimState m) r -> m ()
eval = error ""
iterateFunc :: (PrimMonad m, MVector v r)
=> (forall v' . (MVector v' r) => DimFun v' m r) -> DimFun v m r
iterateFunc = error ""
f :: (PrimMonad m, MVector v r)
=> DimFun v m r
f = error ""
iteratedF :: (MVector v r, PrimMonad m)
=> v (PrimState m) r -> m ()
iteratedF y =
let f' = f
in eval (iterateFunc f') y
This code does not compile:
Testing/Foo.hs:87:14:
Could not deduce (MVector v0 r) arising from a use of ‘f’
from the context (MVector v r, PrimMonad m)
bound by the type signature for
iteratedF :: (MVector v r, PrimMonad m) =>
v (PrimState m) r -> m ()
at Testing/Foo.hs:(84,14)-(85,39)
The type variable ‘v0’ is ambiguous
Relevant bindings include
f' :: DimFun v0 m r (bound at Testing/Foo.hs:87:9)
y :: v (PrimState m) r (bound at Testing/Foo.hs:86:11)
iteratedF :: v (PrimState m) r -> m ()
(bound at Testing/Foo.hs:86:1)
In the expression: f
In an equation for ‘f'’: f' = f
In the expression: let f' = f in eval (iterateFunc f') y
Testing/Foo.hs:88:26:
Couldn't match type ‘v0’ with ‘v'’
because type variable ‘v'’ would escape its scope
This (rigid, skolem) type variable is bound by
a type expected by the context: MVector v' r => DimFun v' m r
at Testing/Foo.hs:88:14-27
Expected type: DimFun v' m r
Actual type: DimFun v0 m r
Relevant bindings include
f' :: DimFun v0 m r (bound at Testing/Foo.hs:87:9)
In the first argument of ‘iterateFunc’, namely ‘f'’
In the first argument of ‘eval’, namely ‘(iterateFunc f')’
Failed, modules loaded: none.
However, if I change the definition of iteratedF to
iteratedF y = eval (iterateFunc f) y
the code compiles wtih GHC 7.8.2. This question is not about the strange-looking signatures or data types, it is simply this: why does renaming f to f' break the code? This seems like it has to be a bug to me.
Disabling the monomorphism restriction, I can compile your code. So, just add
{-# LANGUAGE NoMonomorphismRestriction #-}
at the beginning of your file.
The reason for the type error is that the definition
let f' = f
does not use a function pattern (e.g. f' x y = ...), so the monomorphism restriction kicks in and forces f' to be monomorphic, while iterateFunc requires a polymorphic function.
Alternatively, add a type annotation
let f' :: (PrimMonad m, MVector v r) => DimFun v m r
f' = f
The problem is of course not the renaming, but the binding to a new variable. Since iterateFunc is Rank-2, it needs a polymorphic argument function. Of course, f is polymorphic in v, so it can be used. But when you write f' = f, it's not clear what type f' should be: the same polymorphic type as f, or some monomorphic type, possibly depending some relation to another type variable in iteratedF which the compiler hasn't deduced yet.
The compiler defaults to the monomorphic option; as chi says this is the monomorphism restriction's fault here so if you turn it off your code actually compiles.
Still, the same problem can turn up even without the monomorphism restriction in RankNTypes code, it can't be avoided completely. The only reliable fix is a local signature, usually necessitating ScopedTypeVariables.
I have a large number of in place vector functions of the type
f :: (M.MVector v r, PrimMonad m) =>
v (PrimState m) r -> v (PrimState m) r -> m ()
These functions mostly work in-place, so it is convenient to have their argument be a mutable vector so that I can compose, iterate, etc. However, at the top level, I only want to work with immutable "Haskell"/pure vectors.
Here is an example of the problem:
{-# LANGUAGE TypeFamilies,
ScopedTypeVariables,
MultiParamTypeClasses,
FlexibleInstances #-}
import Data.Vector.Generic as V hiding (eq)
import Data.Vector.Generic.Mutable as M
import Control.Monad.ST
import Control.Monad.Primitive
f :: (M.MVector v r, PrimMonad m) =>
v (PrimState m) r -> v (PrimState m) r -> m ()
f vIn vOut = do val <- M.read vIn 0
M.write vOut 0 val
applyFunc :: (M.MVector v r, PrimMonad m, V.Vector v' r, v ~ Mutable v') =>
(v (PrimState m) r -> v (PrimState m) r -> m ()) -> v' r -> v' r
applyFunc g x = runST $ do
y <- V.thaw x
g y y -- LINE 1
V.unsafeFreeze y
topLevelFun :: (V.Vector v r) => r -> v r
topLevelFun a =
let x = V.replicate 10 a
in applyFunc f x -- LINE 2
The code as written results in an error on LINE 1:
Could not deduce (m ~ ST s)
Expected type: ST s ()
Actual type: m ()
in the return type of g, LINE 1
Commenting out LINE 1 results in the error on LINE 2:
Ambiguous type variable `m0' in the constraint:
(PrimMonad m0) arising from a use of `applyFun'
I've tried a variety of explicit typing (using ScopedTypeVariables, explicit foralls, etc) but haven't found a way to fix the first error. For the LINE 1 error, it seems that m should simply be inferred to be ST s since I'm in a runST.
For the LINE 2 error (with LINE 1 commented out), the only thing I've come up with that works is
class Fake m v where
kindSig :: m a -> v b c
instance Fake m v
topLevelFun :: forall m v v' r . (V.Vector v' r, M.MVector v r, PrimMonad m, Fake m v, v ~ Mutable v') => r -> v' r
topLevelFun a =
let x = V.replicate 10 a
in applyFunc (f::Transform m v r) x -- LINE 2
which is obviously unsatisfactory: I have to create a fake class, with an even more pointless method whose only job is to demonstrate the kinds of the class arguments. Then I create a generic instance for everything so that I can have m in scope in topLevelFun, so that I can add a constraint and cast f. There has GOT to be a better way.
I could be doing a wide variety of things wrong here, so any suggestions would be helpful.
Does the following type for applyFunc work for you?
applyFunc :: (Vector v a) =>
(forall s. Mutable v s a -> Mutable v s a -> ST s ())
-> v a -> v a
That should compile with out problem so long as you have the Rank2Types extension, which you need because you work with a function that has to work on all ST monads. The reason for this is the type of runST is (forall s. ST s a) -> a, so the body of the code after runST needs to work for all s, hence g needs to work for all s.
(You could instead take a function that work with all PrimMonads but there are strictly fewer of those).
GHC can not infer higher rank types. There are very good reasons to not infer RankNTypes (it is undecidable), and although Rank2 is in theory inferable, the GHC people decided for the rule "infer if and only if the principle type is a Hindley-Milner type" which for people like me is very easy to reason about, and makes the compiler writers job not so hard.
In the comments you ask about taking a tuple. Tuples with polymorphic types require ImpredicativeTypes and can be done like
applyFuncInt :: (Vector v a) =>
((forall s. Mutable v s a -> Mutable v s a -> ST s ()),Int)
-> v a -> v a
applyFuncInt (g,_) x = runST $ do
y <- V.thaw x
g y y
V.unsafeFreeze y
although, usually it would be better to simply pass the number as a separate argument.
I'm writing a Haskell library which uses Data.Vector's. I successfully wrote library function, but I don't know how to add signature to it. Below is a simple example illustrating the problem:
import qualified Data.Vector.Generic as V
-- zip two vectors and return first element as a tuple
test :: (V.Vector v a, Fractional a) => v a -> v a -> (a, a)
test a b = (V.zip a b) V.! 0
This code causes following compilation error:
Could not deduce (V.Vector v (a, a))
from the context (V.Vector v a, Fractional a)
arising from a use of `V.zip' at MyLib.hs:7:12-20
Possible fix:
add (V.Vector v (a, a)) to the context of
the type signature for `test'
or add an instance declaration for (V.Vector v (a, a))
In the first argument of `(V.!)', namely `(V.zip a b)'
In the expression: (V.zip a b) V.! 0
In the definition of `test': test a b = (V.zip a b) V.! 0
Code is complied if I comment out the signature of test function. What is a correct signature here?
I'm using GHC 6.12.3, vector library 0.7.0.1.
Thanks.
ghci says:
Prelude Data.Vector.Generic> :t \a b -> (Data.Vector.Generic.zip a b) Data.Vector.Generic.! 0
\a b -> (Data.Vector.Generic.zip a b) Data.Vector.Generic.! 0
:: (Vector v a, Vector v b, Vector v (a, b)) =>
v a -> v b -> (a, b)
Matching with your case, the signature should be
test :: (V.Vector v a, Fractional a, V.Vector v (a, a)) => v a -> v a -> (a, a)
(oh and you need FlexibleContexts)