Re: [Haskell-cafe] let vs. where

2007-11-16 Thread Henning Thielemann

On Fri, 16 Nov 2007, jeff p wrote:

> A function is an expression whose type is an arrow; e.g. Int -> Int.
> The type of taxRate is (Fractional t) => t.

I had this misunderstanding too, when starting with Haskell. In other
languages there are functions with zero, one or more arguments. In
contrast to that, Haskell functions have exactly one argument and one
result, which I find is a nice thing. In other languages this is
asymmetric, you can have multiple arguments but only one result. It is not
possible to pass a struct to a function that expects multiple arguments.
However, due to heavy usage of Schoenfinkel form in Haskell's standard
functions the situation is similar in Haskell.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-16 Thread Arnar Birgisson
On Nov 16, 2007 12:26 AM, Lennart Augustsson <[EMAIL PROTECTED]> wrote:
> On Nov 14, 2007 1:05 AM, Robin Green <[EMAIL PROTECTED]> wrote:
> >
> > On Tue, 13 Nov 2007 13:51:13 -0800
> > "Dan Piponi" <[EMAIL PROTECTED]> wrote:
> >
> > > Up until yesterday I had presumed that guards only applied to
> > > functions. But I was poking about in the Random module and discovered
> > > that you can write things like
> > >
> > > a | x > 1 = 1
> > >   | x < -1 = -1
> > >   | otherwise = x
> > >
> > > where 'a' clearly isn't a function.
> >
> > Isn't it a function taking zero arguments?
>
> No, Haskell functions take exactly one argument.

Depends on who you ask. From [1]:


taxRate = 0.06

total cart = subtotal + tax
  where
subtotal = sum cart
taxable  = filter isTaxable cart
tax = (sum taxable) * taxRate

This example defines two functions, taxRate, which returns a constant
value, and total, which computes the total cost of the list of items
in a shopping cart. (Although the taxRate definition appears to be
defining a variable, it's best to think of it as a constant function,
a function that takes no parameters and always returns the same
value.) The definition of total is quite expressive, and highlights
the intent of the function, by isolating and naming important
sub-expressions in the computation. (total also refers to an isTaxable
function, not presented here.)


Technically, all Haskell functions may take exactly one parameter -
but focusing only on semantics, I guess there's really nothing wrong
with considering constants as parameterless functions, is there?

[1]

cheers,
Arnar
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-15 Thread jeff p
Hello,

> 
> taxRate = 0.06
>
> total cart = subtotal + tax
>   where
> subtotal = sum cart
> taxable  = filter isTaxable cart
> tax = (sum taxable) * taxRate
>
> This example defines two functions, taxRate, which returns a constant
> value, and total, which computes the total cost of the list of items
> in a shopping cart. (Although the taxRate definition appears to be
> defining a variable, it's best to think of it as a constant function,
> a function that takes no parameters and always returns the same
> value.) The definition of total is quite expressive, and highlights
> the intent of the function, by isolating and naming important
> sub-expressions in the computation. (total also refers to an isTaxable
> function, not presented here.)
> 
>
This explanation is just wrong.

A function is an expression whose type is an arrow; e.g. Int -> Int.
The type of taxRate is (Fractional t) => t. There is some leeway for
taxRate to be a function if someone provided a Fractional instance for
a function type; but that seems to be beyond the scope of the quoted
text which comes from an introductory explanation.

Furthermore, a constant function is a function which ignores its
argument; e.g. \x -> 0.06

-Jeff
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-15 Thread Lennart Augustsson
No, Haskell functions take exactly one argument.

On Nov 14, 2007 1:05 AM, Robin Green <[EMAIL PROTECTED]> wrote:

> On Tue, 13 Nov 2007 13:51:13 -0800
> "Dan Piponi" <[EMAIL PROTECTED]> wrote:
>
> > Up until yesterday I had presumed that guards only applied to
> > functions. But I was poking about in the Random module and discovered
> > that you can write things like
> >
> > a | x > 1 = 1
> >   | x < -1 = -1
> >   | otherwise = x
> >
> > where 'a' clearly isn't a function.
>
> Isn't it a function taking zero arguments?
> --
> Robin
> ___
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-15 Thread Arnar Birgisson
On Nov 16, 2007 12:35 AM, Arnar Birgisson <[EMAIL PROTECTED]> wrote:
> [1]

I'm terribly sorry, that was meant to be:

[1] 
http://www.onlamp.com/pub/a/onlamp/2007/07/12/introduction-to-haskell-pure-functions.html

sorry,
Arnar
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-15 Thread hjgtuyl
On Thu, 15 Nov 2007 12:31:07 +0100, Henning Thielemann  
<[EMAIL PROTECTED]> wrote:

On Tue, 13 Nov 2007, Dan Piponi wrote:

On Nov 13, 2007 1:24 PM, Ryan Ingram <[EMAIL PROTECTED]> wrote:
> I tend to prefer where, but I think that guards & function  
declarations are

> more readable than giant if-thens and case constructs.

Up until yesterday I had presumed that guards only applied to
functions. But I was poking about in the Random module and discovered
that you can write things like

a | x > 1 = 1
  | x < -1 = -1
  | otherwise = x


Btw. I would write here
  min 1 (max (-1) x)
 or even better define a function for such clipping, since it is needed
quite often.


The value of 'a' needs only be calculated once; when defined at top level,  
'a' is a CAF; in a 'where' clause, the value is also calculated once.


--
Met vriendelijke groet,
Henk-Jan van Tuyl


--
http://functor.bamikanarie.com
http://Van.Tuyl.eu/
--

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-15 Thread Henning Thielemann

On Tue, 13 Nov 2007, Dan Piponi wrote:

> On Nov 13, 2007 1:24 PM, Ryan Ingram <[EMAIL PROTECTED]> wrote:
> > I tend to prefer where, but I think that guards & function declarations are
> > more readable than giant if-thens and case constructs.
>
> Up until yesterday I had presumed that guards only applied to
> functions. But I was poking about in the Random module and discovered
> that you can write things like
>
> a | x > 1 = 1
>   | x < -1 = -1
>   | otherwise = x

Btw. I would write here
  min 1 (max (-1) x)
 or even better define a function for such clipping, since it is needed
quite often.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-14 Thread C.M.Brown
Hi Neil,

> Why not:
>
> exp = let blah = g 1000
>  in (fst blah, snd blah)

Yes, fair enough.

> Where's always get desugared to let's, so where's are never more efficient.

Interesting. I'm thinking a where-to-let refactoring and its converse may
make useful routine refactorings for HaRe.

Cheers,
Chris.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-14 Thread Neil Mitchell
Hi Chris,

> this could be captured nicely in a where clause:
>
> exp = (fst blah, snd blah) where blah = gg 1000
>
> But a let would have to be placed in both elements of the tuple
>
> exp = (let blah = g 1000 in fst blah, let blah = g 1000 in snd blah)

Why not:

exp = let blah = g 1000
 in (fst blah, snd blah)

Where's always get desugared to let's, so where's are never more efficient.

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-14 Thread C.M.Brown
Hi David,

> A let clause would work fine here:
>
> someFunction ls a b c = let listLen = length ls
> someAuxFunction x y = ... listLen ...
> someOtherFunction x y = ... listLen ...
> in
> ... listLen ...
>
> it's just that you don't want to mix let and where clauses, because then
> things get confusing.  Even if it worked with both, noone would know the
> binding rules.

Possibly in that case, but there are cases where I believe they are not
the same.

For example:

gg n = ([1..,10^6*n], [1..10^6*n])

exp = (fst $ gg 1000, snd $ gg 1000)

this could be captured nicely in a where clause:

exp = (fst blah, snd blah) where blah = gg 1000

But a let would have to be placed in both elements of the tuple - and
therefore being evaluated twice (unless the implementation is smart enough
to work out they can be shared?):

exp = (let blah = g 1000 in fst blah, let blah = g 1000 in snd blah)

Kind regards,
Chris.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Derek Elkins
On Tue, 2007-11-13 at 13:51 -0800, Dan Piponi wrote:
> On Nov 13, 2007 1:24 PM, Ryan Ingram <[EMAIL PROTECTED]> wrote:
> > I tend to prefer where, but I think that guards & function declarations are
> > more readable than giant if-thens and case constructs.
> 
> Up until yesterday I had presumed that guards only applied to
> functions. But I was poking about in the Random module and discovered
> that you can write things like
> 
> a | x > 1 = 1
>   | x < -1 = -1
>   | otherwise = x
> 
> where 'a' clearly isn't a function. Seems like a nice readable format
> to use. Probably everyone except me already knew this already though.

Yep.

Haskell and Haskell code very often avoids special/corner cases.
There's no reason that shouldn't work so it does.  Other examples are:
nullary fundeps, class Foo a | -> a where ...  ; non/record syntax for
pattern matching, case x of App {} -> ... ; guards pretty much
everywhere

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Robin Green
On Tue, 13 Nov 2007 13:51:13 -0800
"Dan Piponi" <[EMAIL PROTECTED]> wrote:

> Up until yesterday I had presumed that guards only applied to
> functions. But I was poking about in the Random module and discovered
> that you can write things like
> 
> a | x > 1 = 1
>   | x < -1 = -1
>   | otherwise = x
> 
> where 'a' clearly isn't a function.

Isn't it a function taking zero arguments?
-- 
Robin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread David Roundy
On Tue, Nov 13, 2007 at 11:41:20AM -0800, Justin Bailey wrote:
> On Nov 13, 2007 10:56 AM, John Lato <[EMAIL PROTECTED]> wrote:
> > I know there are several important differences between let-expressions
> > and where-clauses regarding scoping and the restriction of "where" to
> > a top-level definition.  However, frequently I write code in which
> 
> One place I find it useful is when there is  a common computed value
> that is used throughout a function definition. For example, imagine
> some function that uses the length of a list passed in:
> 
>   someFunction ls a b c = ... (length ls)
>  where
>someAuxFunction x y = ... length ls ..
>someOtherFunction x y = ... length ls ...
> 
> a where clause can capture that calculation, make sure it's only done
> once, and shared throughout the function definition:
>
>   someFunction ls a b c = ... listLen ...
>  where
>listLen = length ls
>someAuxFunction x y = ... listLen ...
>someOtherFunction x y = ... listLen ...
> 
> Notice a let clause wouldn't do it above, because "length ls" is
> called inside other functions defined in the where clause. Of course
> everything could be moved to a "let" clause in the function body. At
> that point I think it's purely stylistic.

A let clause would work fine here:

someFunction ls a b c = let listLen = length ls
someAuxFunction x y = ... listLen ...
someOtherFunction x y = ... listLen ...
in
... listLen ...

it's just that you don't want to mix let and where clauses, because then
things get confusing.  Even if it worked with both, noone would know the
binding rules.
-- 
David Roundy
Department of Physics
Oregon State University
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread David Roundy
On Tue, Nov 13, 2007 at 07:16:01PM +, Sebastian Sylvan wrote:
> I use let in monadic code and in lambda expressions, and where clauses
> everywhere else, pretty much. It's pretty much entirely based on what
> I think "looks" nice.

That's what I do, except I rarely use either where or let in lambda
expressions--things just get too crowded.  But let is great in monadic
code, since you can leave out the "in", which is always what makes let
ugly.
-- 
David Roundy
Department of Physics
Oregon State University
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Dan Piponi
On Nov 13, 2007 1:24 PM, Ryan Ingram <[EMAIL PROTECTED]> wrote:
> I tend to prefer where, but I think that guards & function declarations are
> more readable than giant if-thens and case constructs.

Up until yesterday I had presumed that guards only applied to
functions. But I was poking about in the Random module and discovered
that you can write things like

a | x > 1 = 1
  | x < -1 = -1
  | otherwise = x

where 'a' clearly isn't a function. Seems like a nice readable format
to use. Probably everyone except me already knew this already though.
--
Dan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Ryan Ingram
I tend to prefer where, but I think that guards & function declarations are
more readable than giant if-thens and case constructs.

"where" can scope over multiple guards, and guards can access things
declared in a "where" clause, both of which are important features:

f xs | len > 2   = y
 | len == 1  = 0
 | otherwise = -y
  where
 len = length xs
 y = ...
compare to

f xs =
let len = length xs
y = ...
in if len > 2 then y
   else if len == 1 then 0
   else -y

The indenting hides the structure of the second function.

   -- ryan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Thomas Schilling
On Tue, 2007-11-13 at 13:08 -0800, Donn Cave wrote:
> On Tue, 13 Nov 2007, Neil Mitchell wrote:
> 
> >> This depends on whether you are an "expression style" or "declaration
> >> style" programmer.
> >>   http://www.haskell.org/haskellwiki/Declaration_vs._expression_style
> >>   http://www.haskell.org/haskellwiki/Let_vs._Where
> > 
"Monadification" is a refactoring.  You want IDE support for this
anyways, so I don't think one should prefer let over where solely for
the purpose that one day you might do this transformation.  I personally
prefer where clauses, since code becomes very readable if you name your
functions well.

However, if you refer to variables bound inside monadic code, you simply
have to use 'let'.  

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Neil Mitchell
Hi

> Maybe it would be enough to represent the example "where" problem more
> fairly on its own terms.  The non-working example has us writing
>
>   f = State $ \ x -> y
>  where y = ... x ...

I just don't think this example is representative of the typical
decisions in the trade-off. There are reasons to use let, and reasons
to use where, but refactoring the entire code into a state monad isn't
one I would have ever come up with!

A more balanced variant of the page could mention this as one
particular case where a let might be preferred, but the fundamental
question of let vs where should deal with things like expression vs
statement, scoping, textual ordering, strictness, pattern matching,
desugaring etc - but probably mainly focus on "style".

My personal view is to nearly always use a where, except in a monad,
where a do-let is correct choice. I very occasionally use a let-in,
but only for reasons of textual ordering.

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Henning Thielemann

On Tue, 13 Nov 2007, John Lato wrote:

> I'd like to thank Henning for pointing out the wiki page, which
> describes one consequence I hadn't considered.  I knew I couldn't have
> been the first person to have this question, but I somehow missed it
> before.  I agree with Neil, though, that it doesn't seem very neutral.

Add advantages of 'where' as you like.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Donn Cave
On Tue, 13 Nov 2007, Neil Mitchell wrote:

>> This depends on whether you are an "expression style" or "declaration
>> style" programmer.
>>   http://www.haskell.org/haskellwiki/Declaration_vs._expression_style
>>   http://www.haskell.org/haskellwiki/Let_vs._Where
> 
> Reading the let vs where page I'm left with the strong impression that
> I should use let everywhere. I know that's not true, and in fact I
> much prefer where. Can we put a Wikipedia style "NPOV" (neutral point
> of view) tag on that page? Or can someone do some editing?

Maybe it would be enough to represent the example "where" problem more
fairly on its own terms.  The non-working example has us writing

  f = State $ \ x -> y
 where y = ... x ...

but the "where" side of the aisle is supposed to detest lambdas, so would
be unlikely to have taken this particular route anyway.

I'm not saying "ergo, there is no problem after all", only that it's not
all that well taken.

Donn Cave, [EMAIL PROTECTED]

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread John Lato
I'd like to thank Henning for pointing out the wiki page, which
describes one consequence I hadn't considered.  I knew I couldn't have
been the first person to have this question, but I somehow missed it
before.  I agree with Neil, though, that it doesn't seem very neutral.

On Nov 13, 2007 1:58 PM, Neil Mitchell <[EMAIL PROTECTED]> wrote:
> Hi
>
> > This depends on whether you are an "expression style" or "declaration
> > style" programmer.
> >   http://www.haskell.org/haskellwiki/Declaration_vs._expression_style
> >   http://www.haskell.org/haskellwiki/Let_vs._Where
>
> Reading the let vs where page I'm left with the strong impression that
> I should use let everywhere. I know that's not true, and in fact I
> much prefer where. Can we put a Wikipedia style "NPOV" (neutral point
> of view) tag on that page? Or can someone do some editing?
>
> Thanks
>
> Neil
>
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Neil Mitchell
Hi

> This depends on whether you are an "expression style" or "declaration
> style" programmer.
>   http://www.haskell.org/haskellwiki/Declaration_vs._expression_style
>   http://www.haskell.org/haskellwiki/Let_vs._Where

Reading the let vs where page I'm left with the strong impression that
I should use let everywhere. I know that's not true, and in fact I
much prefer where. Can we put a Wikipedia style "NPOV" (neutral point
of view) tag on that page? Or can someone do some editing?

Thanks

Neil
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Henning Thielemann

On Tue, 13 Nov 2007, John Lato wrote:

> Hello,
>
> I know there are several important differences between let-expressions
> and where-clauses regarding scoping and the restriction of "where" to
> a top-level definition.  However, frequently I write code in which
> either one would be allowed, and I was wondering if there were any
> guidelines or preferences for one structure over the other.  Currently
> my choice is guided by aesthetics more than anything else ( I prefer
> the look and ordering of a where clause).  Is there anything else I
> should consider?  What do veteran Haskell programmers prefer?

This depends on whether you are an "expression style" or "declaration
style" programmer.
  http://www.haskell.org/haskellwiki/Declaration_vs._expression_style
  http://www.haskell.org/haskellwiki/Let_vs._Where
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Justin Bailey
On Nov 13, 2007 10:56 AM, John Lato <[EMAIL PROTECTED]> wrote:
> I know there are several important differences between let-expressions
> and where-clauses regarding scoping and the restriction of "where" to
> a top-level definition.  However, frequently I write code in which

One place I find it useful is when there is  a common computed value
that is used throughout a function definition. For example, imagine
some function that uses the length of a list passed in:

  someFunction ls a b c = ... (length ls)
 where
   someAuxFunction x y = ... length ls ..
   someOtherFunction x y = ... length ls ...

a where clause can capture that calculation, make sure it's only done
once, and shared throughout the function definition:

  someFunction ls a b c = ... listLen ...
 where
   listLen = length ls
   someAuxFunction x y = ... listLen ...
   someOtherFunction x y = ... listLen ...

Notice a let clause wouldn't do it above, because "length ls" is
called inside other functions defined in the where clause. Of course
everything could be moved to a "let" clause in the function body. At
that point I think it's purely stylistic.

Justin
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] let vs. where

2007-11-13 Thread Sebastian Sylvan
On Nov 13, 2007 6:56 PM, John Lato <[EMAIL PROTECTED]> wrote:
> Hello,
>
> I know there are several important differences between let-expressions
> and where-clauses regarding scoping and the restriction of "where" to
> a top-level definition.  However, frequently I write code in which
> either one would be allowed, and I was wondering if there were any
> guidelines or preferences for one structure over the other.  Currently
> my choice is guided by aesthetics more than anything else ( I prefer
> the look and ordering of a where clause).  Is there anything else I
> should consider?  What do veteran Haskell programmers prefer?


I use let in monadic code and in lambda expressions, and where clauses
everywhere else, pretty much. It's pretty much entirely based on what
I think "looks" nice.




-- 
Sebastian Sylvan
+44(0)7857-300802
UIN: 44640862
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe