Jay Cox <[EMAIL PROTECTED]> writes:
> On Thu, 14 Mar 2002, Brian Huffman wrote:
>
> > In Haskell you can produce the desired behavior by using pattern guards.
> > Since the pattern guards always get evaluated before the result does, they
> > can be used to make things more strict. Here is the fo
On Saturday, March 16, 2002, 03:16 CET Jay Cox wrote:
> [...]
> I think I may eventually attempt to write a haskell lazyness/strictness FAQ.
Great! I'm very interested in it.
> [...]
Wolfgang
___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haske
Alright. I know the haskell community probably gets tired of my long
winded posts. I This post probably shouldn't even be on
[EMAIL PROTECTED] (more like on haskell-cafe). I also realize that
these posts may not mean much to you; many of you may have figured out
most of this strictness business
matt hellige writes (to the haskell mailing list):
>[..] consider:
>sum 0 x = x
>sum x y = x + y
>
>if the first argument is 0, we don't need to inspect the second
>argument at all.
But sum returns its second argument, so it's still strict in that
argument.
Cheers,
Ronny Wichers Schr
On Thu, 14 Mar 2002, Brian Huffman wrote:
> In Haskell you can produce the desired behavior by using pattern guards.
> Since the pattern guards always get evaluated before the result does, they
> can be used to make things more strict. Here is the foldl example:
>
> strict x = seq x True
>
> fold
On Thu, 14 Mar 2002, Andrew Butterfield wrote:
> I think the Clean type system does stuff like this - it certainly supports
> strictness analysis and annotations:
> - see http://www.cs.kun.nl/~clean/ for more details
Thanks to both you and to Bernard James POPE for the replies.
The embarrasin
[Jay Cox <[EMAIL PROTECTED]>]
>
> (+):: Num a => a -> a -> a therefore sum :: Num a => [a] -> a -> a
> now, for any conceivable sum, you generally need both arguments to compute
> it (or am I wrong?), so i guess you could say (+) should probably be
> strict for both arguments. But how would you
At 22:47 13/03/02 -0600, Jay Cox wrote:
>Perhaps what could be done about this strictness business is to make a
>kind of strictness annotation. Perhaps something that says (force the
>second argument of function F before every call to F (including any time F
>calls itself)).
>...
>here's a rough
> Ratio defines
> data (Integral a) => Ratio a = !a :% !a
> which GHC seems to implement as specified, but nhc and hugs seem to use
> data (Integral a) => Ratio a = a :% a
> Does this not have different strictness properties?
It does. In nhc98's case, this is simply an oversight -
Strange. You don't supply a complete program, so it's hard to
test.
Nevertheless, the Haskell Report (Sect 3.12) specifies that
a let adds a single twiddle. Thus
let (x, (y,z)) = e in b
means
let x = case e of (x,(y,z)) -> x
y = case e of (x,(y,z)) -> y
On Fri, Mar 02, 2001 at 06:58:16PM +, Marcin 'Qrczak' Kowalczyk wrote:
> Toplevel ~ in let doesn't change anything. But nested ~'s do make
> a difference. When a variable of a pattern is evaluated, the whole
> pattern is matched. When you protect a subpattern by ~ deferring its
> matching and
Thanks for the prompt reply. Hugs apparently is more lazy and
performs all the matching lazily, and that really makes a difference
in my case.
Doaitse
At 8:11 AM -0800 3/2/01, Simon Peyton-Jones wrote:
>Strange. You don't supply a complete program, so it's hard to
>test.
>
>Nevertheless, t
Thu, 1 Mar 2001 12:25:33 +0100, S. Doaitse Swierstra <[EMAIL PROTECTED]> pisze:
> From the Haskell manual I understand that pattern matching in "let"'s
> should be done lazily, so the addition of a collection of ~'s should
> not make a difference.
Toplevel ~ in let doesn't change anything. But
Jeffrey R. Lewis wrote:
| Hmm... indeed. I wonder if there's any reason why zipWith can't just be fully lazy
| so that we don't need to twiddle with transpose. I.e., define it as:
|
| zipWith :: (a->b->c) -> [a]->[b]->[c]
| zipWith z ~(a:as) ~(b:bs) = z a b : zi
Jonas Holmerin wrote:
> The other day, I tried to transpose an infinite list of finite list:
> Simplified example:
>
> transpose (repeat [1..5])
>
> This won't terminate, since transpose is defined as
>
> transpose :: [[a]] -> [[a]]
> transpose = foldr
>
In all of this, I neglected to mention *why* I think unlifted tuples
are a good idea. I've given various reasons, but not the real one.
The real one is: Embarassment. I wrote an implementation of linear
logic in Haskell. It took a while before I discovered why my
implementation got into a loo
> To correctly evaluate seq (x, y) 5 it would be necessary to concurrently
> evaluate x and y, since (x, y) is bottom if and only if both x and y are
> bottom. (I enjoy finding a flaw in Miranda because there are so few to
> be found!)
Another flaw: There is a seq hidden in foldl.
-
Theoretical arguments regarding the distinction between lifted vs
unlifted tuples (i.e., any type declaration with single disjunct) are
too esoteric for my taste. However, there are some practical reasons
to choose one over the other. In the Id implementation, no
distinction is made between li
Paul writes:
| Like Ian, I would like to suggest that we lift functions in Haskell.
| Originally there was a good reason not to: there was no need (and
| indeed no way) to distinguish _|_ from \x->_|_. But now there are
| some compelling reasons to make the distinction:
I would say that there
Paul Hudak notes:
|Similarly, given an equation:
|
| f (Foo x y) = y
|
|
|If Foo is strict in its first component then I can't use this equation
|at will; I need to qualify it:
|
| f (Foo x y) = yif x /= _|_
|
|
|(And again, the first equ
Strictness annotations are not annotations, since they change the
meaning of a program. Let's use the term strictness indicators.
As I mentioned in an earlier message to this mail group, with
> f (Pair a b) = b
the value of (f (Pair x 5)) may not be 5, when Pair involves strictness
indicators
Strictness annotations do not completely remove the need for unlifted
products. (However, on balance I am inclined to stay with lifted
products only, rather than add a new language feature.)
In a lifted product, bottom /= (bottom, bottom). That is, a new bottom
is added onto the produce, so
Paul writes,
I think it's important to realize that laws aren't being entirely
lost -- they're just being weakened a (wee) bit, in the form of
carrying an extra constraint. For example, eta conversion:
\x -> f x = f
must simply be modified slightly:
\x -
Phil writes:
> In the absence of convincing answers, I'd rather have as many laws
> as possible, hence my preference for unlifted tuples and products.
Here's another law that I find useful:
If we write
f p = p
where p is some pattern&expression then I expect f to be the identity
func
If Lennart was asking, `Shall we make laws a paramount design feature
of Haskell, and therefore go for unlifted tuples, unlifted functions,
and no n+k or literal patterns', my answer would be `let's go for it'.
But I suspect what Lennart is really asking is `Shall we ignore laws,
have lifted tup
Indeed. Notice that there is a similar difference between call-by-need
and call-by-value beta:
(\x -> u) t = u[t/x] call-by-need
(\x -> u) t = u[t/x] if t /= _|_call-by-value
But here we seem to think the difference is important.
Paul and Phil write,
| What are the disadvantages of having a lifted function space?
|
| I think the main one is that we lose unrestricted eta
| conversion. But maybe that's not such a big deal either.
|
| We keep claiming that functional languages are good because they
| sa
I've separated this from my previous note, because it's about the
precise question of strictness annotations rather than the more general
question of laws.
I would rather tell someone that to define a new type exactly
isomorphic to an old type they need to write
newtype Type = Construc
Paul writes,
What are the disadvantages of having a lifted function space?
I think the main one is that we lose unrestricted eta
conversion. But maybe that's not such a big deal either.
We keep claiming that functional languages are good because they
satisfy lots of la
I would rather tell someone that to define a new type exactly
isomorphic to an old type they need to write
newtype Type = Constructor typeexp
then tell them that they need to write
data Type = Constructor !typeexp
The latter smacks too much of magic. This is clearly a m
I think it's important to realize that laws aren't being entirely
lost -- they're just being weakened a (wee) bit, in the form of
carrying an extra constraint. For example, eta conversion:
\x -> f x = f
must simply be modified slightly:
\x -> f x = fif f /= _|_
(I should al
(This is a message on strictness, etc. I was too busy to reply
earlier when the discussion first began).
Like Ian, I would like to suggest that we lift functions in Haskell.
Originally there was a good reason not to: there was no need (and
indeed no way) to distinguish _|_ from \x->_|_. But n
> Yes, in general it's not possible. That is, I can't write a function
>
> evaluate :: a -> a
>
> which will force its argument to WHNF.
I don't think you mean what you are actually saying, it's perfectly possible
write evaluate :-)
evaluate x = x
This function will evaluate its a
> Hi !
>
> Can anyone tell me whether it's possible to force Haskell to evaluate an
> expression strict ?
Yes, in general it's not possible. That is, I can't write a function
evaluate :: a -> a
which will force its argument to WHNF. I can, as you've noted, write
a function:
e
My apologies for the previous message, which was intended to go to
Cornel Klein only.
-Konstantin
Cornel,
> data Sequ a = Empty
> | Cons (a,Sequ a)
wieso verwendest Du hier nicht einfach [a]?
> If the typevariable "a" would be restricted to range over the typeclass Eq,
> the dirty trick of adding the guard
>
> n==n
>
> to the definition of mergesort could be used
36 matches
Mail list logo