Bang patterns
Ben Rudiak-Gould
Benjamin.Rudiak-Gould at cl.cam.ac.uk
Mon Feb 6 08:54:58 EST 2006
Simon Peyton-Jones wrote:
>http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/BangPatterns
You say that
let !(x, Just !y) = <rhs> in <body>
can't be desugared to
let
t = <rhs>
x = case t of (x, Just !y) -> x
y = case t of (x, Just !y) -> y
in
t `seq` <body>
and I agree. But that's not the desugaring I'd expect; I'd expect this:
let t1@(x, Just t2 at y) = <rhs> in t1 `seq` t2 `seq` <body>
which does have the appropriate semantics, I think.
You can also desugar let ![x,y] = e in b to let t1@[x,y] = e in t1 `seq` b
instead of case e of { [x,y] -> b }, which would solve the polymorphism problem.
The other thing that isn't obvious to me is what should happen when ! is
nested inside ~. Naively
case e of { (x,~(y,!z)) -> b }
should be equivalent to
case e of { (x,t1) -> let (y,!z) = t1 in b }
which should be equivalent to
case e of { (x,t1) -> let (y,t2 at z) = t1 in t2 `seq` b }
But this is the same as
case e of { (x,(y,!z)) -> b }
In other words, the ~ has no effect, which is not what I expect. I think
there's an incompatibility between the interpretation of ! in let and case
expressions. In let expressions it needs to be able to escape from the
implicit ~, while in case expressions it should stay inside. One possible
solution would be to make top-level ~ significant in let expressions, but
that feels a bit strange too.
Another minor point: allowing
module Foo where
!x = ...
would mean that adding an import statement to a terminating program could
change it into a nonterminating one.
-- Ben
More information about the Haskell-prime
mailing list