1

Originally I assumed the scope of a nested universal quantifier on the LHS of a function type can be determined purely syntactical, i.e. everything inside the parenthesis of (forall a. a -> b) -> Bool is within the same scope. However, this assumption is wrong:

{-# LANGUAGE RankNTypes #-}

fun :: (forall a. [a] -> b) -> Bool
fun _ = undefined

arg :: c -> c
arg _ = undefined

r = fun arg -- type variable a would escape its scope

This makes sense, because in fun b must be chosen before a and thus be fixed or independent of a. During unification the argument type c -> c would force b's instantiation with [a0] though.

So maybe scoping at the type level rather resembles that of functions at the term level, where the result value is clearly not part of the function's scope. In other words if b weren't the codomain of the function type, the type checker would pass. Unfortunately, I couldn't come up with an annotation that supports my reasoning.

A more restrictive way would be to disallow the instantiation of rigid type variables with any flexible one of the same annotation during unification. Both ways seem legitimate to me, but how does this actually work in Haskell?

  • For any variables that don't have an explicit `forall`, an implicit one is inserted right after the nearest `::`, so your example is equivalent to `fun :: forall b. (forall a. [a] -> b) -> Bool` – Fyodor Soikin Feb 13 '21 at 22:22
  • 2
    I find it very helpful to think about `forall` as type-level equivalent of lambda. Term-level equivalent of your example would look something like ``fun = \b -> (\a -> [a] `foo` b) `bar` True`` – Fyodor Soikin Feb 13 '21 at 22:25
  • @FyodorSoikin, that sounds a bit off to me. Type lambdas are term-level things in languages supporting them. Haskell's `forall` is just a way to make type arguments explicit in type signatures. `forall a. [a] -> b` is the type of a term whose first argument is a type, `a`, and whose second argument is a value of type `a`. – dfeuer Feb 14 '21 at 00:28
  • @dfeuer They're not "just a way to make explicit", they are important for specifying scope. Before rank-N types there was only one possible scope, so Haskell didn't have `forall`, but now that scopes can be different it's suddenly necessary. Check out [this article](https://medium.com/collegevine-product/forall-is-the-type-level-lambda-9237b4ca6827) I wrote some time ago, it has a bit more on the subject. – Fyodor Soikin Feb 14 '21 at 01:04
  • @FyodorSoikin, right, they specify scope. They bind names, like lambdas do, but they're otherwise quite different. – dfeuer Feb 14 '21 at 01:21
  • Well, I didn't say they were the same. – Fyodor Soikin Feb 14 '21 at 01:30

1 Answers1

2

Non-quantified type variables are implicitly quantified at the top-level. Your types are equivalent to

fun :: forall b . (forall a. [a] -> b) -> Bool
arg :: forall c . c -> c

Hence, the scope of b is the whole type.

You can think of each forall'ed variable as a kind of implicit additional type argument the function receives. I think you understand that, in a signature like

foo :: Int -> (String -> Bool) -> Char

the Int value is chosen by the caller of foo, while the String value is chosen by foo when (and if) it calls the function passed as a second argument.

In the same spirit,

fun :: forall b. (forall a. [a] -> b) -> Bool

means that b is chosen by the caller of fun, while a is chosen by fun itself.

The caller can indeed pass the b type explicitly using TypeAnnotations and write

fun @Int :: (forall a. [a] -> Int) -> Bool

After that, an argument of type forall a. [a] -> Int must be apssed, and length fits such polymorphic type.

fun @Int length :: Bool

Since this is the call site for fun we don't get to see where the "type argument" a is passed. That indeed can only be found in the definition of fun.

Well, it turns out that it's not really possible to define a fun which that type that makes a meaningful call to its argument (length, above). It would be if we had a slightly different signature like this:

fun :: forall b. Eq b => (forall a. [a] -> b) -> Bool
fun f = f @Int [1,2,3] /= f @Bool [True, False]

Here we can see that f (to be bound to length by the call) is called twice at two distinct types. This produces two values of type b that can then be compared to produce the final Bool.

chi
  • 111,837
  • 3
  • 133
  • 218