[Haskell-cafe] Re: [Haskell] View patterns in GHC: Request for feedback

Dan Licata drl at cs.cmu.edu
Mon Jul 30 05:31:40 EDT 2007


With the functional dependency, you can't work with the view datatypes
at all.  Once you write

type Typ
data TypView = Unit | Arrow Typ Typ

instance View Typ TypView where
  view = ...

you're no longer allowed to take apart a TypView at all!

E.g. you can't write

outUnit :: TypView -> Bool
outUnit Unit = True
outUnit _    = False

because the implicit application of the view function will mean that
outUnit must consume a Typ.  

Personally, I'd rather have special syntax in the pattern (-> pat) than
have these global effects on what you can do with certain types.

-Dan


On Jul27, Stefan O'Rear wrote:
> On Fri, Jul 27, 2007 at 05:22:37AM -0400, Dan Licata wrote:
> > On Jul26, Stefan O'Rear wrote:
> > > > So, this syntax affects a lot of code, existing or otherwise, that
> > > > doesn't use view patterns, which is something we're trying to avoid.
> > > 
> > > Eh?  I *think* the typing rules are the same for the no-view case.  If
> > > the auto-deriving hack isn't implemented, you only need a
> > > deriving(View), otherwise there should be no change at all...
> > 
> > Assuming you don't have the functional dependency: "affects" in the
> > sense that any code you write has a generalized type, so you have to
> > explain view patterns to beginners right out of the gate, etc.  If you
> > write 
> > 
> > length [] = []
> > length (h : t) = 1 + length t
> > 
> > we don't want to have to explain to beginners why it has type
> > 
> > length :: forall a,b,c. View a [b] -> a -> Num c
> 
> Right, which is why I think the functional dependency is good.  If we
> have it, and the auto-deriving hack, what breaks?
> 
> length [] = []
> length (h : t) = 1 + length t
> 
> length :: forall a b c. (View a [b], Num c) => a -> c
> 
> ==> (one of the FD rules)
> 
> length :: forall a b c. (View [a] [b], Num c) => [a] -> c
> 
> ==> (plain context reduction, the first constraint is tautological)
> 
> length :: forall a c. Num c => [a] -> c
> 
> Stefan



> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list