Re: LAST CALL to comment on the Appicative/Monad Proposal

2018-12-18 Thread Doug McIlroy
I am very glad to see Applicative take its place in the
report: one less mystery in understanding Haskell in the
wild. The following comments pertain to presentation.

13.1 Functor class

"The Functor class is used for types that can be mapped over."

"is used for" is extremely vague. Better wording would be
"The functor class comprises types that can be mapped over."

The same comment applies to section 6.3.5.

13.2 Applicative class

A verbal hint about the mnemonic intent of liftA2,
like those for liftA and liftA3 in 13.4, would be helpful.

Why is the "methods" subsection empty?

13.3 Alternative class

This class hasn't been fully integrated into the report.

It is missing from the Standard Prelude (Section 9)
and from its natural place after 6.3.6.

<|> appears here without definition and is not in the index.

Why is the "methods" subsection empty?

Doug McIlroy
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime


Re: Shall the Haskell Report remain in LaTeX?

2017-11-07 Thread Doug McIlroy
> The good thing about laTeX is that out of all the candidates it is the
> most likely one to still work 40 years from now,

If past results are any measure of future performance, the only
candidate with demonstrated 40-year longevity is troff/groff :)

Doug McIlroy
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime


Re: Multiple imports on a single line

2017-02-02 Thread Doug McIlroy
> I often see a confusion between greater expresiveness (good goal) and
> having to type less (largely irrelevant goal). By all means make the module
> system more expressive, but try to avoid "clever" things for convenience.

To expand upon this principle a bit, syntactic sugar that promises to save O(1) 
typing in an n-line module is suspect; that which might save O(n) is more 
promising.

Doug


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime


Re: Doubts about functional programming paradigm

2015-12-15 Thread Doug McIlroy
Though this post was prompted by beginn...@haskell.org, it 
seemed pertinent enough for cross-posting to haskell-prime.

> I just wanted to make a point that learning haskell is *much*
> harder than learning most other programming languages

I would not put it that way. One gets so much farther in
capability almost instantly with a functional language.
I know. At the dawn of functional programming, John McCarthy
could teach in one hour everything from cons up to symbol
manipulation that would have been a month's project in
Fortran. (My account of that hour is at
http://www.paulgraham.com/mcilroy.html.)

What's hard about Haskell is that its landscape extends into
terrains not imagined elsewhere. As long as you stay in the
flat Floridian landscape of Fortran et al, you don't need
to explore the Himalayas of Haskell. But of course the very
exhilaration and inspiration of the high peaks draws one
into the "*much* harder" training necessary to surmount them.

> the learning aids that are available are not yet cohesive
> enough to present a clear path ahead for the average programmer.

I agree with this. Alas, there does not exist a definition of
the Haskell one reads about on the haskell-cafe mailing list.
I treasure my hardcover Haskell 98 report--so rare you can't
even find it in the used-book marketplace. Haskell 2010 was
obsolete as soon as it was promulgated. Contemporary Haskell as
practiced by cognoscenti flaps in a gale of language pragmas.
There is no authoritative source about these pragmas. They are
listed and described in the GHC User Guide, but that source
all too often defines solely by example, not even bolstered by
a formal syntax specification.

I earnestly hope the newly revived Haskell-prime committee can
rectify this state of affairs, and that GHC will provide a
compliant implementation.

Doug McIlroy
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime


Re:definition of List.transpose

2015-03-01 Thread Doug McIlroy
Sorry for a stylistic lapse in a post I just sent from 
the wrong file. A tail should be called ts, not tss, in the
proposed reference definition for List.transpose

Doug

transpose xss = case [h | (h:_) - xss] of
[] - []
hs - hs : transpose [ts | (_:ts) - xss]
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime


definition of List.transpose

2015-03-01 Thread Doug McIlroy
Not having participated in haskell' before, I'm not sure how
to put these perfecting amendments--mot langauge changes--into
the pot.

Doug McIlroy


The specification of List.transpose does not tell what a column
of a ragged-right list of rows is, either directly or by example.
Here is a fuller spec, plus some properties.

-

A generalization of the customary matrix operation, transpose returns
a list of columns extracted from a list of rows.  The jth column
of x::[[a]] comprises all extant elements x!!i!!j ordered by i.

In the subdomain of list structures that have positive nonincreasing
row lengths, e.g. matrices and Young tableaux,
transpose . transpose === id
(transpose x) !! i !! j === x !! j !! i
In general
transpose . transpose . transpose === transpose
sum . map length . transpose === sum . map length

Example: transpose [[10,11],[20],[],[30,31,32]] === [[10,20,30],[11,31],[32]]

-

The reference definition can be simplified:

transpose xss = case [h | (h:_) - xss] of
[] - []
hs - hs : transpose [tss | (_:tss) - xss]
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-prime


Re: [Haskell-cafe] Non-recursive let

2013-07-11 Thread Doug McIlroy
By analogy to ML, which has let and let rec, where the latter
corresponds to Haskell's let, one is led to let nonrec. I
would definitely not like shadow, for it means that new
variable does NOT cast a shadow on its definining expression.

I fear also that let nonrec by any name would introduce another
attractive nuisance, just as insidious as the one it is intended
to correct. For example
x = ...
let nonrec { x = someFunction x
 xsq = x^2} in ...
won't do what was probably intended. In my own code, this idiom
is more likely than the one that sparked the discussion.

Doug

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


Re: [Haskell-cafe] Remove Enum from Float and Double

2013-06-26 Thread Doug McIlroy
   it's the entire Enum class which doesn't have a consistent or sensible 
  semantics

Yes, for a language with generally sound mathematical roots, Enum is
an embarrassment. My pet peeve is that Rationals are enumerable, but
not with Enum. And the differing lengths of [1,4..6] and [1.0,4.0..6.0]
will shock even the non-mathematically inclined.

Much of the craziness can be hidden if in place of [a..b] for
nonintegral numeric types, one uses (map fromInteger [a..b]).
Perhaps that should happen automatically.

As for the horror mentioned at the end of the first paragraph,
the language definition's oafish attempt to get right things
like [0.0,0.1..1.0] needs major revision.

Doug McIlroy

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


Re: relaxing instance declarations

2013-04-30 Thread Doug McIlroy
Max's idea (see below) of a second where clause is cute, but
not sanctioned by Haskell syntax.

Iavor wrote, It would be quite arbitrary to restrict this only
to instances.

Actually what I have in mind is to make the language MORE
consistent, by eliminating distinctions between instance-wheres
and ordinary declaration-wheres.  Currently instance-wheres may
only declare class methods, while declaration-wheres may declare
variables at will.  Also instance-wheres may not declare type
signatures, while declaration-wheres may.  I propose dropping
these restrictions on instance-wheres.

Hazard: Adding a method to an existing class could accidentally
capture a name that was previously local to an instance-where.
Capture can be prevented by declaring type signatures for local
variables.  The compiler might warn when such defensive
declarations are lacking.

Doug

On Mon, 29 Apr 2013 15:56 Iavor Diatchki iavor.diatc...@gmail.com wrote

Hello,

I think that if we want something along those lines, we should consider a
more general construct that allows declarations to scope over other
declarations (like SML's `local` construct).  It would be quite arbitrary
to restrict this only to instances.

-Iavor



On Mon, Apr 29, 2013 at 2:41 PM, Max Bolingbroke batterseapo...@hotmail.com
 wrote:

 You could probably get away with just using two where clauses:

 instance Foo a where
 bar = ...
   where
 auxilliary = ...




 On 28 April 2013 18:42, Edward Kmett ekm...@gmail.com wrote:

 Makes sense. I'm not sure what a good syntactic story would be for that
 feature though. Just writing down member names that aren't in the class
 seems to be too brittle and error prone, and new keywords seems uglier than
 the current situation.

 Sent from my iPad

 On Apr 28, 2013, at 1:24 PM, Doug McIlroy d...@cs.dartmouth.edu wrote:

  Not always. For example, you can't mess with the declaration
  of a standard class, such as Num.
 
  On Sun, Apr 28, 2013 at 12:06 PM, Edward Kmett ekm...@gmail.com
 wrote:
 
  You can always put those helper functions in the class and then just
 not
  export them from the module.
 
  On Sun, Apr 28, 2013 at 10:49 AM, Doug McIlroy d...@cs.dartmouth.edu
 wrote:
 
  Is there any strong reason why the where clause in an instance
  declaration cannot declare anything other than class
  operators? If not, I suggest relaxing the restriction.
 
  It is not unusual for declarations of class operators to
  refer to special auxiliary functions. Under current rules
  such functions have to be declared outside the scope in
  which they are used.
 
  Doug McIlroy

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



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



Content-Type: text/html; charset=UTF-8

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


relaxing instance declarations

2013-04-28 Thread Doug McIlroy
Is there any strong reason why the where clause in an instance 
declaration cannot declare anything other than class
operators? If not, I suggest relaxing the restriction.

It is not unusual for declarations of class operators to
refer to special auxiliary functions. Under current rules
such functions have to be declared outside the scope in
which they are used.

Doug McIlroy

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


Re: relaxing instance declarations

2013-04-28 Thread Doug McIlroy
Not always. For example, you can't mess with the declaration
of a standard class, such as Num.

On Sun, Apr 28, 2013 at 12:06 PM, Edward Kmett ekm...@gmail.com wrote:

 You can always put those helper functions in the class and then just not
 export them from the module.

On Sun, Apr 28, 2013 at 10:49 AM, Doug McIlroy d...@cs.dartmouth.eduwrote:

 Is there any strong reason why the where clause in an instance
 declaration cannot declare anything other than class
 operators? If not, I suggest relaxing the restriction.

 It is not unusual for declarations of class operators to
 refer to special auxiliary functions. Under current rules
 such functions have to be declared outside the scope in
 which they are used.

 Doug McIlroy

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


Re: [Haskell-cafe] ifdef based on which OS you're on

2013-02-17 Thread Doug McIlroy
With apologies for prolonging a tangential topic, I'd like to
sharpen anti-ifdef comments that have been posted already.

1. An ifdef for portability is an admission of nonportability.

What it does is point out a nonportability--a useful crutch
for maintainers, but a crutch nonetheless.

2. Ifdefs violate program structure.

All ifdefs appear at top level. Yet, save for those that control
top-level declarations, they embody conditionals at inner levels
of structure.

Doug McIlroy

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


Re: [Haskell-cafe] education or experience?

2012-12-09 Thread Doug McIlroy
 Yes... CS academics delivers less than it could/should;
 and whatever this delivery is, its asymptotically sub-linear.
 Some of it is to do with the not-quick-enough takeup of FP in academia,
 though there are obviously many other factors as well.

 http://blog.languager.org/2011/02/cs-education-is-fat-and-weak-1.html
 and sequel is about this: how we are not getting over the quirks of the
 past history of CS in present day teaching. Here too suggestions for
 modifications/ change of emphasis are appreciated.

Rusi's cogent blog post includes a list of techniques/concepts that
the unconverted could profitably pick up from the FP community.
In fact the FP community came late to some of these, just as 
programming languages at large came late to garbage collection.

Lazy evaluation--at the heart of spreadsheets since the beginning.
Pattern matching--native to string processing (e.g. COMIT, SNOBOL).
  Appeared nearly in its present form in COGENT (1965).
Booleans as first class*--surely this is a joke. Algol 60 had them.
  Matlab exploits them heavily (though represented as doubles).
Data orientation--COBOL fostered this outlook; see Michael Jackson.
  As long as Lisp ruled, FP lagged on data types.

FP also deserves credit for infinite data structures (though the special
case of stream processing dates way back).

Doug McIlroy

* It's amusing to note that real Booleans--the ones that Boole 
used--were integers. For Boole, or(a,b) = a + b - a*b.

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


Re: [Haskell-cafe] education or experience?

2012-12-09 Thread Doug McIlroy
  Lazy evaluation--at the heart of spreadsheets since the beginning.

 Never thought of that  -- nice!

Unfortunately it's not literally true, because spreadsheets push
recalculated values to all the variables that depend on them,
rather than waiting until the dependent values are needed.  But
the idea that sequencing is by dependency rather than by
algorithmic specification is the same.  I remember playing around
(before spreadsheets) with the idea for Fortran-like code and 
concluding that the benefit of not having to specify sequence 
wasn't worth the effort. What a lack of imagination!

  Pattern matching--native to string processing (e.g. COMIT, SNOBOL).
Appeared nearly in its present form in COGENT (1965).

 Hmm google gives me different cogents/  I guess you are referring to the
 Reynolds one?

Yes.

  Booleans as first class*--surely this is a joke. Algol 60 had them.

 Not sure what you are saying (unless its about the footnote that Boole
 treated bools as ints! This is new to me)  I was referring to the fact that
 C programmers have great difficulty thinking of bools as first class

Your observation is interesting. Booleans and their utility were well
known when C was designed. But since the language level was
deliberately very close to real machine architecture, which rarely
had native support for 1-bit quantities, the data type was deemed
superfluous. (If C had begun on the IBM 7030 it probably would have
have had Booleans.) I don't remember anybody predicting that the choice
risked banishing Booleans from mind.  The one deviation from real
architecture that C did embrace was to define a representation for 
the result of comparison.  That had another unpredicted consequence:
computer architects imitated the language in hardware! (C's largely
ignored bitfield capability came later and, if anything, demoted
Booleans to an artifact of structs.)

The joke I saw was that there was no way that Boolean values
had ever been denied first-class citizenship as Strachey defined
it--even if they didn't have a special syntactic identity.

Matlab exploits them heavily (though represented as doubles).

 Not sure what you are referring to

I had in mind Matlab's frequent use of a Boolean array as
a characteristic function describing some property of the
elements of another array.  Such arrays are used to control
other array operations. In this usage, the characteristic
array may be optimized out of existense, but it fosters
higher-level thinking and concise code.

In reply to your second note, Malcolm Wallace is right. I did
intend to say that FP was late with lazy evaluation.  My mistake
was to think VisiCalc had appeared before 1970. Similarly,
I believed that call by need came into our vocabulary
soon after Algol 60 brought call be name and call by value to
our attention as somewhat better-behaved models than Fortran's
call by reference. Now I suspect that belief is wrong, too.

Doug

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


Re: [Haskell-cafe] education or experience?

2012-12-09 Thread Doug McIlroy

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


definition of transpose

2012-12-01 Thread Doug McIlroy
The description of transpose in Haskell 2010, section 20.2,
does not tell how unequal-length rows are treated.
A more revealing example would help, perhaps something like
transpose [[1,2],[3],[4,5,6]] == [[1,3,4],[2,5],[6]]

Notice that the usual identities, (transpose x)!!i!!j==x!!j!!i
and transpose.transpose==id do not hold unless row lengths
are monotone non-increasing.

[It might be well to restrict the input so the identities do hold.
This would simplify explanation, implementation, and proofs. Has
anybody found transpose useful outside this domain?]

Doug McIlroy

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


[Haskell-cafe] size of Haskell Platform

2012-11-11 Thread Doug McIlroy
This note is an offshoot of curl package broken in Windows,
where this item appeared:

 Did you know that Strawberry Perl includes a cygwin gcc?
 ...
 Maybe Haskell Platform could do the same.

The suggestion brought to mind a true-life parable: the pump
station at Tok.  (Tok is the third corner--after Anchorage
and Fairbanks--of Alaska's triangular core of long-distance
highways.) When I visited Tok long ago, it was a village of
several hundred souls, almost all of whom were employed by one
government agency or another, principal among which were the
highway department, the Alaska Communication Service and the
pump station, which kept fuel flowing to Eielson Air Force Base.

The mission of the station was to keep one pump running 24 hours
a day. Most of the time, of course, the pump hummed along by
itself. To assure that, there had to be a standby machine,
an operator to watch over both, and a mechanic who could fix
them if need be.  For such a lonely job it was deemed well to
have two operators. And there had to be two operators for each
of several shifts. A little redundancy on the mechanical side
seemed wise, too.  The crew and their families, say nothing of
the pumps themselves, needed to be housed, and the installation
needed to be supplied with the necessities of life. (The nearest
supermarket was in Fairbanks, 300 miles away.)  These needs
demanded a motor pool and property maintenance cadre, whose
very presence reinforced the need.

Thus the support team to keep one pump going ballooned to about
100 people--a chain reaction that barely avoided criticality.

So it seems to be with Haskell Platform, which aims to include
all you need to get up and running--an extensive set of
standard libraries and utilities with full documentation. I
get the impression that the Platform is bedeviled by the
same prospect of almost unfettered growth.

[One ominous sign: the description of the Haskell Platform
at lambda.haskell.org/platform/doc/current/start.html suggests
that one must join some mysterious Cabal, whose nature is
hidden by a link to nowhere, simply to get started.]

What principles guide the selection of components for all
you need to get up and running?

Doug McIlroy

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


Re: backslashes within quotes

2012-10-05 Thread Doug McIlroy

 \xe\x1 is unambiguous.

There are two things wrong with this solution:

(1) It descends to another level of discourse--binary encoding of characters.

(2) It does not actually eliminate the need for \. Consider the
string \SOH1.  It cannot be written \x11, or even \x011.

Doug McIlroy

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


Re: [Haskell-cafe] attoparsec double precision, quickCheck and aeson

2012-06-06 Thread Doug McIlroy
 Date: Tue, 5 Jun 2012 10:25:26 -0700
 From: Warren Harris warrensomeb...@gmail.com
 
 On Jun 5, 2012, at 9:57 AM, Johan Tibell wrote:
 
 I don't think applying == to something that contains floating point
 values at the leaves makes much sense. You want some approxEq function
 that uses approximate equality on floating point value or you want to
 equality function that ignores the floating point values. Probably not
 the answer you like, but I don't know how to define Eq in a robust way
 for types that include floating point values.
 
 I buy that in general for comparing floats (those that result from arithmetic 
 operations), but this is a case where attoparsec's parser is munging the 
 value. I would like to have a law that says parse . print == id ... which 
 is why this seems more like a bug than the usual floating point concerns. 
 This law seems to hold for haskell's double parser: quickCheck (\d - read 
 (show d) == d)
 
 Date: Tue, 5 Jun 2012 10:51:08 -0700
 From: Bryan O'Sullivan b...@serpentine.com
 
 If you need the full precision, use rational instead. The double parser is
 there because parsing floating point numbers is often a bottleneck, and
 double intentionally trades speed for precision.

If I understand the intended meaning of parse correctly, what's at
issue is decimal-to-binary conversion. It is hard to defend sloppy
answers for such a fundamental operation. The recommendation of
rational calculation makes little sense for most floating-point
computation, which approximates irrationals. The necessary
imprecision, though, does not justify sloppiness--and especially
not sloppy tests.

It's worth noting that a law of input being inverse
to output must fail, though rarely. Different granularity of 
the two bases means that there must exist cases where adjacent 
values in one base convert to the same value in the other.
(Conceivably the specialization to parse.print could hold
for some hardware. Does anybody know whether the
wish is actually hopeless?)

Last I looked (admittedly quite a while ago), the state of
the art was strtod in http://www.netlib.org/fp/dtoa.c.
(Alas, dtoa.c achieves calculational perfection via a
murmuration of #ifdefs.)

It's disheartening to hear that important Haskell code has
needlessly fallen from perfection--perhaps even deliberately.

Doug McIlroy

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


Re: [Haskell-cafe] Requesting Feedback: I Love Haskell, but can't find a place to use it

2012-06-01 Thread Doug McIlroy
  I love Haskell. It is my absolute favorite language.
  But I have a very hard time finding places where I can actually use it!
 
 have you considered your head as such a place that should be easy to find.

An excellent reason.  Haskell shines unusually brightly on
applications that have an algebraic structure. Laziness
relieves a plethora of sequencing concerns.  I particularly
treasure one experience:

I asked a guru about the complexity of converting regular
expressions to finite-state automata without epsilon transitions
(state transitions that don't produce output).  The best he
knew was O(n^3), which is the cost of removing epsilon transitions
from arbitrary automata.  Then I wrote about a dozen lines of Haskell
to do the job--and running time turned out to be O(n^2). Once
I'd written the code, it became clear how to do it in other
languages, but I never would have found the theorem without
the help of Haskell.  (This without even bringing in the heavy
artillery of higher-order functions and monads.)

Doug McIlroy

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


Re: [Haskell-cafe] Requesting Feedback: I Love Haskell, but can't find a place to use it

2012-06-01 Thread Doug McIlroy
  I love Haskell. It is my absolute favorite language.
  But I have a very hard time finding places where I can actually use it!
 
 have you considered your head as such a place that should be easy to find.

Excellent advice.  Haskell shines unusually brightly on
applications that have an algebraic structure. And laziness
relieves a plethora of sequencing concerns.  I particularly
treasure one experience:

I asked a guru about the complexity of converting regular
expressions to finite-state automata without epsilon transitions
(state transitions that don't produce output).  The best he
knew was O(n^3), which is the cost of removing epsilon transitions
from arbitrary automata.  Then I wrote about a dozen lines of Haskell
to do the job--and running time turned out to be O(n^2). Once
I'd written the code, it became clear how to do it in other
languages, but I never would have found the theorem without
the help of Haskell.  (This without even bringing in the heavy
artillery of higher-order functions and monads.)

Doug McIlroy

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


Re: [Haskell-cafe] adding the elements of two lists

2012-03-29 Thread Doug McIlroy
 From: Richard O'Keefe o...@cs.otago.ac.nz
 Date: Thu, 29 Mar 2012 16:34:46 +1300
 
 On 29/03/2012, at 3:08 PM, Doug McIlroy wrote:
  - without newtype
  
  toSeries f = f : repeat 0   -- coerce scalar to series
  
  instance Num a = Num [a] where
(f:fs) + (g:gs) = f+g : fs+gs
(f:fs') * gs@(g:gs') = f*g : fs'*gs + (toSeries f)*gs'
  
  - with newtype
  
  newtype Num a = PS a = PS [a] deriving (Show, Eq)
  
  fromPS (PS fs) = fs -- extract list
  toPS f = PS (f : repeat 0)  -- coerce scalar to series
  
  instance Num a = Num (PS a) where
(PS (f:fs)) + (PS (g:gs)) = PS (f+g : fs+gs)
(PS (f:fs)) * gPS@(PS (g:gs)) =
   PS $ f*g : fromPS ((PS fs)*gPS + (toPS f)*(PS gs))
 
 Try it again.
 
 newtype PS a = PS [a] deriving (Eq, Show)
 
 u f (PS x)= PS $ map f x
 b f (PS x) (PS y) = PS $ zipWith f x y
 to_ps x   = PS (x : repeat 0)
 
 ps_product (f:fs) (g:gs) = whatever
 
 instance Num a = Num (PS a)
   where
 (+) = b (+)
 (-) = b (-)
 (*) = b ps_product
 negate  = u negate
 abs = u abs
 signum  = u signum
 fromInteger = to_ps . fromInteger
 
 I've avoided defining ps_product because I'm not sure what
 it is supposed to do: the definition doesn't look commutative.

You have given the Hadamard product--a construction with somewhat
esoteric properties.  The product I have in mind is the ordinary
mathematical product that one meets in freshman calculus.  The
distributive law yields this symmetric formulation

(f:fs) * (g:gs) = f*g : (toSeries f)*gs + fs*(toSeries g) + (0 : fs*gs)

The version I gave is an optimization (which I learned from Jerzy). For more
explanation see www.cs.dartmouth.edu/~doug/powser.html.

I like the lifting functions b and u, but they don't get one very far.
The product is where the PS pox begins to bite badly. I would welcome 
a perspicuous formulation of that using newtype.

Incidentally, a more efficient way to write the symmetric product is

(f:fs) * (g:gs) = f*g : zipWith (f*) gs + zipWith fs (*g) + (0 : fs*gs)

toSeries and zipWith appear in the formulas because Haskell overloading
won't let one use the multiplication symbol for both series*series and
scalar*series. One might also invent a distinct operator for the purpose.
Coercion with toSeries strikes me as the least jarring of these approaches.
zipWith suffers from mixing levels of abstraction--it signifies not the
idea of multiplication, but the algorithm.  A new operator would suffer
both from unfamiliarity and lack of commutativity.

 
  The code suffers a pox of PS.
 
 But it doesn't *need* to.
 
 

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


[Haskell-cafe] winhugs interrupts

2012-03-28 Thread Doug McIlroy
On windows I have long used hugs under cygwin, but hugs
doesn't get along well with cygwin's latest terminal
emulator.  So I switched to winhugs.  Small problem
that looms big: how do you interrupt an interminable
expression evaluation in winhugs?

Doug

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


Re: [Haskell-cafe] adding the elements of two lists

2012-03-28 Thread Doug McIlroy
 Date: Tue, 27 Mar 2012 11:03:54 +1300
 From: Richard O'Keefe o...@cs.otago.ac.nz
 Subject: Re: [Haskell-cafe] adding the elements of two lists
 To: jerzy.karczmarc...@unicaen.fr
 Cc: haskell-cafe@haskell.org
 
 And *that* is why I stopped trying to define instance Num t = Num [t].
 If I KNEW that the length of the lists is ... fixed ... then the type
 wasn't *really* [t], but some abstract type that happened to be implemented
 as [t], and that abstract type deserved a newtype name of its own.
 
 Naming the type
  - makes the author's intent clearer to readers
  - lets the compiler check it's used consistently
  - lets you have instances that don't match instances for
other abstract types that happen to have the same implementation
  - provides a natural place to document the purpose of the type
  - gives you a way to enforce the intended restrictions
 all for zero run-time overhead.

Quite taken by this manifesto for high style and morality,
I resolved to do right by some old code, of which I had
been quite proud: www.cs.dartmouth.edu/~doug/powser.html.
Sadly, the exercise took some bloom off the rose. What
the code gained in honesty and safety, it lost in beauty
and readability.

Here's the contrast, seen in overloading arithmetic to
handle addition and multiplication of power series.

- without newtype

toSeries f = f : repeat 0   -- coerce scalar to series

instance Num a = Num [a] where
   (f:fs) + (g:gs) = f+g : fs+gs
   (f:fs') * gs@(g:gs') = f*g : fs'*gs + (toSeries f)*gs'

- with newtype

newtype Num a = PS a = PS [a] deriving (Show, Eq)

fromPS (PS fs) = fs -- extract list
toPS f = PS (f : repeat 0)  -- coerce scalar to series

instance Num a = Num (PS a) where
   (PS (f:fs)) + (PS (g:gs)) = PS (f+g : fs+gs)
   (PS (f:fs)) * gPS@(PS (g:gs)) =
  PS $ f*g : fromPS ((PS fs)*gPS + (toPS f)*(PS gs))

The code suffers a pox of PS. When one goes on to
introduce efficiencies and generalize to handle
finite series (polynomials), it only gets worse.

One unpleasant technical problem: the deriving
clause is almost useless--one can't print or
detect equality of infinite objects.  For output  
one must apply something like (take 10 . fromPS).

Yet this modest package would likely pose
problems if it were combined with others in a
grander suite for automated mathematics.  What to
do? I think I might write the package without
newtype, and then wrap it in PS for export in hopes
of exploiting the advantages of both styles.

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


[Haskell-cafe] Haskell showcase in 5 minutes

2012-02-28 Thread Doug McIlroy
Here's an example that fits comfortably in 5 minutes--if
your audience knows elementary calculus:
http://www.cs.dartmouth.edu/~doug/powswer.html
It depends critically on lazy evaluation, which knocks out
a lot of competing languages right from the start.

The five-minute version would begin with power-series
addition--trivial.
Then comes multiplication--an eye-opener. No subscripts! No worry
about how many terms to carry in intermediate results.

That's about all you have time to really derive. Go on
to mention that division is about equally easy.  Then
allude to substitution (also called composition) and its
inverse, reversion.  Lots of finicky papers have been
written about reversion over more than two centuries.
Throw that one-liner on the screen side-by-side with
Algorithm S (which is only pseudocode!) from Knuth
section 4.7.  That should convince the most skeptical
observer.

Doug

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


[Haskell-cafe] Haskell showcase in 5 minutes

2012-02-28 Thread Doug McIlroy
Sorry, a typo in the url for the power-series example.
It should have been
http://www.cs.dartmouth.edu/~doug/powser.html

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


[Haskell-cafe] [haskell-cafe] Some reflections on Haskell

2012-02-14 Thread Doug McIlroy
Kevin Jardine notices the full Haskell ecosystem ... is huge, and
laments the absence of a sophisticated IDE to help manage it.
Being a small-code type, I don't personally enjoy IDE's, which
are undeniably useful in big projects, at the cost of a whole lot
more to learn about programmering in addition to programming.

Nevertheless, I share Jardine's concern about the central problem.
It is hard to find one's way in this ecosystem.  It needn't be,
as Java illustrates.  To my mind Java's great contribution to the
world is its library index--light years ahead of typical
documentation one finds at haskell.org, which lacks the guiding
hand of a flesh-and-blood librarian.  In this matter, it
seems, industrial curation can achieve clarity more easily than
open source.

(To avoid entanglement with social media, this comment is going
to Haskell Cafe rather than Google+ where other comments reside.)

Doug McIlroy

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


[Haskell-cafe] [haskell-cafe] Some reflections on Haskell

2012-02-14 Thread Doug McIlroy
Markus: What about hoogle/hayoo and hackage?

Antoine: Do you have any links to examples that we should imitate?

Hackage is notionally similar to the Java API documentation at
http://www.oracle.com/technetwork/java/javase/documentation/
But Hackage Documentation pages typically only give syntax, while Java
pages invariably summarize semantics.  This makes a world of difference.
The quality of the summaries bespeaks a lot of editorial attention
above and beyond culling annotations from source code.

Considerable care has been taken in describing the GHC library at
http://www.haskell.org/ghc/docs/
but even there one can find absolute mystery entries like
http://www.haskell.org/ghc/docs/latest/html/libraries/haskell98-2.0.0.1/Locale.html

Doug

 It is hard to find one's way in this ecosystm. It needn't be,
 as Java illustrates. To my mind Java's great contribution to the
 world is its library index--light years ahead of typical
 documentation one finds at haskell.org, which lacks the guiding
 hand of a flesh-and-blood librarian. In this matter, it
 seems, industrial curation can achieve clarity more easily than
 open source.

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


Re: Proposal: require spaces around the dot operator

2012-02-11 Thread Doug McIlroy
 +1 to the idea of requiring spaces around all operators. 
 It's just good style

 Cutting things close syntactically just because you can is perhaps 
 not the best of ideas

Haskell is mathematical both in substance and style.  I would
not lightly prohibit the use of spacing conventions that have proved
over centuries to aid in understanding syntactic strucure.

For example, this code fragment to define addition on lists
is instantly intelligible.

instance Num a = Num [a] where
(f:fs) + (g:gs) = f+g : fs+gs

But the formula becomes merely an obscure procession of symbols when 
rewritten with the operators set off by spaces:

( fs : gs ) + ( g : gs ) = f + g : fs + gs

And it becomes too long and too subtly modulated to take in at
a glance if more spacing is added to emphasize precedence:

( f : fs )  +  ( g : gs )   =   f + g   :   fs + gs

Doug McIlroy

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


[Haskell-cafe] [Haskell Cafe] strict version of Haskell - does it exist?

2012-01-30 Thread Doug McIlroy
 Is there any document describing why there is no ghc --strict flag
 making all code strict by default?
 Wouldn't such a '--strict' flag turn Haskell/GHC into a better C/gcc
 compiler?

I agree that a strict flag would turn Haskell into C--but that's a
perversion of Haskell.  Almost all Haskell code I write depends critically
on laziness.  Sure, there are little bits here and there that would run
faster if I carefully decorated them with strict flags.  But the
genius of Haskell is architectural clarity, achieved in no small
part by relegating nasty issues of sequencing to the implementation.

If you even have to think once about what needs to be strict or 
non-strict, then non-strict is the only viable default.  I can't
imagine writing any interesting Haskell code that will successfully 
run all strict.

Doug McIlroy

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


[Haskell-cafe] numeric coercion in ghci vs hugs

2012-01-08 Thread Doug McIlroy
After loading the one-line file
default (Integer,Rational,Double)
the input
1::Fractional t = t
in ghci yields the output
1.0
and in hugs
1%1
The ghci answer appears not to respect the default
declaration.  What's going on?

Doug McIlroy

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


showing Ratios

2010-02-25 Thread Doug McIlroy
Very minor library change to promote readability of output:
eliminate spaces in the string representation of Ratios.

Currently, a Ratio appears as a pair separated by  % .
The spaces that flank % make for confusing output.
Example:

[1 % 2,1 % 3,1 % 4,1 % 5,1 % 6]

The spaces suggest that , binds more tightly than %.
I claim that

[1%2,1%3,1%4,1%5,1%6]

is much more readable.  It also saves paper and/or screen area.

I suspect that the spaces came in to make it easier to find
the division point in a lugubrious Ratio like

123456789%987654321

True enough, but such numbers are too incomprehensible
to get much scrutiny anyway.  I, at least, find that all
I do with Ratios much more complicated than 355%113 is
squirrel them away in tables that only a computer is
likely to read seriously, or edit them into some other
form, e.g. for Sloane's Encyclopedia of Integer Sequences.

Doug McIlroy
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: [Haskell-cafe] If you haven't bought any of Knuth's fascicles yet, this is definitely the one to get. Bitwise Tricks Techniques

2009-11-19 Thread Doug McIlroy

One of Knuth's sources is the well-named book Hacker's Delight by
Henry S. Warren; see hackersdelight.org

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


[Haskell-cafe] omitting params in function bindings

2009-11-17 Thread Doug McIlroy
Is there a deep reason (beyond saving a sentence
or two in the language definition) for requiring
all patterns in a function binding to have the
same explicit arity?

For example, in
dropWhile0 :: Num a = [a] - [a]
dropWhile0 (0:xs) = dropWhile0 xs
dropWhile0 xs = xs
why shouldn't the last line be replaceable by
dropWhile0 = id
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell] type inference instance extensions

2009-01-19 Thread Doug McIlroy
A fragment of an attempt to make pairs serve as complex numbers,
using ghc/hugs extensions:

instance Num a = Num (a,a) where
(x,y) * (u,v) = (x*u-y*v, x*v+y*u)

Unfortunately, type inference isn't strong enough to cope with

(1,1)*(1,1)

Why shouldn't it be strengthened to do so?
Or is there a declarative trick (perhaps with dependent
classes) that will accomplish the goal?

Doug McIlroy
___
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell


[Haskell] Power series in a nutshell

2007-07-12 Thread Doug McIlroy
For lovers of things small and beautiful,
http://www.cs.dartmouth.edu/~doug/powser.html
boils down basic operations on power series with numeric
coefficients to the bare minimum--each is a one-liner.
Included are overloaded arithmetic operators, integration,
differentiation, functional composition, functional inverse
and coercion from scalars. --A telling demonstration of the
power of lazy evaluation and of Haskell's attunement to math.

Doug McIlroy
___
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell


[Haskell] Haskell' Status Report

2006-09-27 Thread Doug McIlroy
One thing jumped out at me from the status report: everything was add,
which reminded me of many old languages designed by accretion.
Are the new facilities so perfectly orthogonal as not to subsume anything
that was already there?  Are none of them simply relaxations of previous
limitatations?   Parsimony is part of the allure of Haskell.  What do
the new facilities enable one to discard from the Haskell 98 report?

Doug McIlroy
___
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell


[Haskell] context rules for default

2006-02-09 Thread Doug McIlroy
What is the rationale for the requirement that, in order for
the ambiguous type of a numeric constant to be resolved by the
default declaration, all classes in the context must be in the
Standard Prelude or Standard Library (Revised Report 4.3.4)?
This makes it hard to introduce new polymorphic functions
whose domain includes the integers.

Doug McIlroy
___
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell