[Haskell] Re: scoped type variables

Norman Ramsey nr at cs.tufts.edu
Mon Mar 16 11:47:42 EDT 2009


[Opening discussion to broader audience: I asked Simon PJ about
scoped type variables and type abbreviations]

 > | With scoped type variables, it would be useful to be able to define
 > | a type abbreviation in a where clause, so that the scoped
 > | type variable could be used on a right-hand side.  Apparently
 > | this wasn't done.  Was there any technical reason why not?
 >
 > Would you care to give an example? Do you mean
 >         f x = e where a = Int

No.  I give an example below, but I've just spent 10 minutes grubbing
through the Haskell 98 Report so I can phrase the question more
precisely:

  Given the extension to scoped type variables, I believe that the
  'type' abbreviation declaration should have been 'promoted' from
  syntactic category 'topdecl' to syntactic category 'decl', because
  it is convenient and useful to be able to exploit a scoped type
  variable in a type abbreviation.  Was this possibility simply
  overlooked, or was a deliberate choice made not to do it?

Here is a synopsis of code I would like to write:

  solve :: forall m l a . Graph m l -> Fuel -> DFM a (a, Fuel)
  solve = solveGraph
    where
       -- in the defintions below, type variable 'a' is free 
       -- on the RHS but is bound by the forall above
       type FactKont b = Graph m l -> a -> Fuel -> DFM a b
       type FuelKont b = Graph m l ->      Fuel -> DFM a b

       solveMid  :: m -> FactKont b -> FactKont b
       solveLast :: l -> FuelKont b -> FactKont b 
         ...

For my sanity I'd like to define type abbreviations that refer to 'm'
and 'l' also...

Under the current regime, I'm forced to do what amounts to lambda
lifting on the type abbreviations.  Not only does this lead to a
extra type parameters which distract from the main event, but in
floating the type abbreviation out to top level, I am forced to choose
a unique name for it, which I might prefer not to do if the same
module contains several similar functions with similar (but not
identical) type abbreviations.  

Of course the naming issue arises even in Haskell 98, but the ability
to bring type variables into scope in a 'where' clause adds urgency.

 > There are lots of design issues.  For example, in GHC today, a scoped type
 > variable stands for a type *variable* not for a *type*.  I took the other
 > approach initially, but I think this is better

I know this distinction is important in instance declarations.
Presumably it also means that the scoped type variable can unify with
something else during type inference?  I fear that without seeing some
formalism I can't be too sure what's going on---is there a technical
report somewhere that explains the distinction?

In any case, I hope this question is orthogonal to the problem of
permitting a type declaration as a 'decl' in a where clause and not a
mere lonely 'topdecl'.   Is anybody else keen to have this ability?


Norman



More information about the Haskell mailing list