Re: Higher-order function application

2000-08-23 Thread Ralf Muschall

Bjorn Lisper <[EMAIL PROTECTED]> writes:

> >cos+sin-- intent: \x->((cos x)+(sin x))
> >cos(sin)   -- intent: \x->cos(sin(x))

> have equivalents in Fortran 90 and HPF, although with arrays rather than
> functions. For instance, one can write "A+B" to mean an array with value

But I'd look at this differently: Essentially it means to have
a typeclass Addable which is a superclass of Num and making vectors
instances of Addable. (If Fortran9x also allows multiplication,
we need no Addable and use Num directly.)

OTOH, something like this is used in Xlisp-stat, and I hate it :-)
(it does make programming harder, since I always have to think (or
even worse, to experiment) whether some function will map itself over
lists or not. (Xlisp-stat is even harder, since it uses lists as well
as vectors. As a result of this "niceness", I have to write all my
functions which might be passed as arguments to HOFs with a typecheck
in order to find out whether the system's functions (like minimizers
etc.) called them with a vector, a list, or a number).

If one really needs to add functions argumentwise in a programm, one
should IMHO use something like

data (Num b) =>  NumFunction a b = NumFunction (a->b)

instance (Num b) => Eq (NumFunction a b)
where
(NumFunction f) == (NumFunction g) = error "cannot eq funcs"

instance (Num b) => Show (NumFunction a b)
where
show (NumFunction f) = error "cannot show funcs"
-- one should use something smarter here

instance (Num b) => Num (NumFunction a b)
where
(NumFunction f)+(NumFunction g) = NumFunction (\x->(f x)+(g x))
(NumFunction f)*(NumFunction g) = NumFunction (\x->(f x)*(g x))
(NumFunction f)-(NumFunction g) = NumFunction (\x->(f x)-(g x))
negate (NumFunction f) = NumFunction (negate . f)
abs (NumFunction f) = NumFunction (abs . f)
signum (NumFunction f) = NumFunction (signum . f)
fromInteger x = NumFunction (\_ -> fromInteger x)
fromInt x = NumFunction (\_ -> fromInt x)

useFunc :: (Num b) => (NumFunction a b) -> a -> b
useFunc (NumFunction f) = f

-- example
h::NumFunction Double Double
h = (NumFunction cos) + (NumFunction sin)
-- useFunc h 0.7 gives 1.40905987
-- usefunc 3 4 gives 3
-- useFunc (1+h*3) 0.01 gives 4.0298495

Ralf




Overlapping types

2000-08-23 Thread Tom Pledger

Tom Pledger writes:
 > [...]
 > 
 > --Subtype should be transitive; I may have done something evil
 > --here, because Classic Hugs (November 1999) with the `-98' flag
 > --rejects this decl with the message `Undefined type variable "b"'
 > instance (Subtype a b, Subtype b c) => Subtype a c where
 > up   x = up (up x)
 > down z = down z >>= down

In case anyone was wondering (or fuming about having explained it in a
previous thread;-) , b wasn't bound in the instance head but should
have been.




Re: code generation for other languages

2000-08-23 Thread Timothy Docker


Manuel M. T. Chakravarty writes:

 > The canonical approach is to define an internal data
 > structure that represents C++ code, then let your mutator
 > functions generate values of that data type (instead of
 > strings), and finally pretty print values of this C++ data
 > structure.  That's cleaner and more flexible than the ++
 > cascades (or the show equivalent).
 > 
 > Depending on how restricted and/or idiomatic the generate
 > C++ code is, it makes sense to not have a data structure
 > that can represent arbitrary C++ programs, but only a subset
 > that is relevant for the code generation task at hand.  So,
 > you might want functions like
 > 
 >   mutatorDef :: ... -> AbstractCPlusPlus
 > 
 >   prettyPrintACPP :: AbstractCPlusPlus -> String


Thanks for the clear description (and to Julian Seward who also
suggested such an approach). Alfter playing with the code a little
more, I had actually already started down this approach. The tricky
bit will be, as you say, defining a data structure that is "just"
general enough.

Tim




REMINDER: PLI 2000 Early Registration Deadline this Friday, August 25th

2000-08-23 Thread Konstantin Läufer

   PLI 2000

   Principles, Logics, and Implementations
 of high-level programming languages

 Montréal, Canada
September 17-22, 2000

 http://www.cs.yorku.ca/pli00

This is a reminder that the early registration deadline for PLI 2000
is August 25th. You need to reserve by the end of this week in order
to get the cheaper registration rates and hotel bookings.

The colloquium on Principles, Logics, and Implementations of high-level
programming languages is a collection of conferences and workshops aimed at
the advancement of high-level programming languages.

PLI 2000 comprises the following conferences and workshops:

ICFPInternational Conference on Functional Programming
PPDPPrinciples and Practice of Declarative Programming

Haskell Workshop on Haskell
HLCLHigh-Level Concurrent Languages
HOOTS   Higher Order Operational Techniques in Semantics
RULERule-Based Programming
Scheme  Workshop on Scheme and Functional Programming
SAIGSemantics, Applications and Implementation of Program Generation
TIC Types in Compilation

For further information and registration forms, see

  http://www.cs.yorku.ca/pli00





REMINDER: ICFP Programming Contest - Task to be posted this Saturday 17:00 EST

2000-08-23 Thread Konstantin Läufer

[Please note that the task for the ICFP Programming Contest will be posted
this Saturday, August 26, at 17:00 EST (5 pm).]

We are pleased to announce:

 The Third Annual

 ICFP PROGRAMMING CONTEST

   August 26-29, 2000

 http://www.cs.cornell.edu/icfp/

Convinced your favorite programming language provides unbeatable
productivity? Do functional languages lead to better and faster
programs? Perhaps it's just the case that functional programming
languages attract better programmers than other languages...and you
and your friends are the best of the best.

If so, we're providing you the opportunity to prove it! We are pleased
to announce the Third Annual ICFP Programming Contest to be held in
conjunction with the 2000 International Conference on Functional
Programming (ICFP'00). All programmers are invited to enter the
contest, either individually or in teams; we especially encourage
students to enter.  You may use any programming language (or
combination of languages) to show your skill.

On Saturday, August 26 at 5pm EST, we will publish a challenge task to
registered participants.  Teams will have until Tuesday, August 29 at
5pm EST (72 hours) to implement a program to perform this task and
submit it to the contest judges.  We've designed the contest for
direct, head-to-head comparison of language technology and programming
skill. We have a range of prizes for the winners: cash awards, famous
texts on functional languages donated and autographed by the authors,
special student prizes, and, of course, unlimited bragging rights.

For more information about the contest, prizes, and registration,
point your browser to:

   http://www.cs.cornell.edu/icfp.

For more information about ICFP 2000, see:

   http://diwww.epfl.ch/~odersky/icfp2000





Re: Tetration operator in functional programming

2000-08-23 Thread Christian Sievers

I had some more ideas on Tim Sweeney's thoughts:

First of all, I was releaved to see that the definition can be
extended to
  b ^^ 0 = 1
(a functional programmer's favourite number must be zero!),
or for types
  void --> t ~= unit

> Now I am trying to understand the type-theory analogy to tetration. Given
> "unit" as the one-valued type, "bool" as the two-valued type, "three" as the
> three-valued type (isomorphic to "maybe bool"), etc., clearly:

I find it hard to believe that the size of a flat domain can make such 
a difference. I find (), Maybe (), Maybe (Maybe ()), ..., which are
not flat, more promising candidates. (Or Void, Maybe Void, ) 
Still I doubt there can be a type constructor Tetra with 
  Tetra () t ~= t  and  
  Tetra (Maybe n) t ~= (Tetra n t) -> t,
although I couldn't disprove it.

It should reflect arithmetic laws of tetration, which for example
relate (b ^^ (a1*a2)) with b^^a1 and b^^a2 or so, but are there any?
So how should (a,b)-->t be defined?

Nevertheless we can nearly do it in Haskell, it's not legal, but the
intended meaning should be clear ;-)

First of all, we use church numerals at the type constructor level -
not my idea, must have seen it in some paper:

  Z :: (* -> *) -> * -> *
  type Z f x = x
  S :: ((* -> *) -> * -> *) -> (* -> *) -> * -> *
  type S n f x = f (n f x)

Now we can define Tetra as
  type Tetra t n = n (->t) ()
just as we could define (^^) as
  b ^^ n = foldnat (b^) 1 n
only that the fold is already built into the numerals.
Tetra hasn't kind * -> * -> *, but has * -> ((* -> *) -> * -> *) -> *.
Now we'd have Tetra t Z = (), Tetra t (S Z) = () -> t ~= t,
Tetra t (S (S Z)) = (() -> t) -> t ~= t -> t and so on.

The problems with this are: Haskell has no kind signatures, so Z gets 
kind * -> * -> *, you can't write (->t), and you can't use a type
synonym without giving all its arguments.

Still it could be instructive to ask yourself what other constructors
of kind (*->*)->*->* you might use, and what you'd get. Most
interessting should be Infinity:
  type Inf f x  = f (Inf f x)
(where we use x to get the correct kind) - this recursive type synonym 
is even more forbidden!

> unit-->t  ~= t
> bool-->t  ~= t->t
> three-->t ~= (t->t)->t
> four-->t  ~= ((t->t)->t)->t
> 
> So, what is going on here?  "bool->t" is the type of identity functions on
> t; "three-->t" is especially interesting because it is the type of fixpoint
> operator from t->t to t.

It's interesting (for those to which this wasn't obvious) to see that
there exists a recursion- und bottom-free term (this is what type
theory usually is about) of type  n-->t  (where n is a number)  iff
n is even:

For n=2 there is id::t->t (or  const id :: (() -> t) -> t, if you use
this) - or if you take my advice and start with zero, there is ()::().

Now if you have f::n-->t, then ($f) has type (n-->t)->t'->t', which is 
even more general than (n+2)-->t.

We know there is no term of type t = 1-->t.

[For the following argument I first wanted to use the
 Curry-Howard-Isomorphism, but then I realized I could show it
 direct. Do I need it if I wanted to rigourously prove there is no term 
 of type t?]
Consider there were a term f of type n-->t = ((n-1)-->t) -> t with odd n>=3.
We already know there is a term h of type (n-1)-->t,
so the application  f h  would have type t, which is impossible.

Of course it is different if you take a fixed non-void type for t.
For example, ($0) has type (more general than) 3-->Int.


Bye,
Christian




Job openings at INRIA

2000-08-23 Thread Gilles Barthe

[Apologies for multiple copies]


Job openings in formal methods for smartcards at INRIA
==

INRIA is opening up several doctoral and post-doctoral
positions at Rocquencourt (projet Coq), Rennes (projet
Lande) and Sophia-Antipolis (projets Lemme and Oasis). 
All positions are related to projects aimed at 
applying formal methods to the verification of the 
JavaCard platform and of JavaCard applications. Most 
projects are carried out in collaboration with leading
industrial companies in the field (Bull, Gemplus, 
Schlumberger) and offer a unique opportunity to 
address scientifically challenging and industrially 
relevant problems.

We seek candidates with a strong background in any of 
the following fields:

- theorem-provers

- model-checkers

- program analysis and transformation

and a strong interest in smartcard and mobile code 
security.

To apply (or for further details) please 
send an email to:

Gilles Barthe ([EMAIL PROTECTED])
http://www-sop.inria.fr/oasis/personnel/Gilles.Barthe/index.html

Yves Bertot ([EMAIL PROTECTED])
http://www-sop.inria.fr/lemme/Yves.Bertot/index.html

Thomas Jensen ([EMAIL PROTECTED]) 
http://www.irisa.fr/lande/jensen/index.html

Christine Paulin ([EMAIL PROTECTED])
http://www.lri.fr/~paulin
 
Your email application should include a CV,
names and addresses of three referees, and,
if available, pointers to on-line articles
(please do *not* include the articles in your
mails). You should also indicate your geographical
preferences, if any.

Applications will be evaluated from now on 
until the positions are filled.




RE: code generation for other languages

2000-08-23 Thread Chris Angus

For doinjg this sort of thing I have used asdl before
which I find really useful.



> -Original Message-
> From: Manuel M. T. Chakravarty [mailto:[EMAIL PROTECTED]]
> Sent: 23 August 2000 14:09
> To: [EMAIL PROTECTED]
> Cc: [EMAIL PROTECTED]
> Subject: Re: code generation for other languages
> 
> 
> Jeffrey Straszhiem <[EMAIL PROTECTED]> wrote,
> 
> > On Wed, Aug 23, 2000 at 12:26:38PM +1000, Timothy Docker wrote:
> > > 
> > > I'm writing a haskell program that generates C++ code based upon
> > > some haskell data structures. At the moment, the code is somewhat
> > > ugly with lots of stuff like
> > > 
> > >   mutatorDef structName (name,vtype) = 
> > >   "inline void\n" ++
> > >   structName ++ "::" ++ (mutatorName name) ++
> > >   "( " ++ (cppParamType vtype) ++ " v ) {\n" ++
> > >   "" ++ (storageName name) ++ " = v;\n" ++
> > >   "}\n\n"
> > > 
> > > All those ++ operators working on raw strings bug me, and manually
> > > getting the indentation correct is a pain. Is there a more
> > > functional approach to generating source code? I thought 
> this could
> > > be a common enough task that there could be a library, 
> but a perusal
> > > of haskell.org didn't seem to show anything relevant.
> > 
> > To make matters worse, you're likely getting lousy 
> efficiency with all
> > of the ++ operators.  Look through the code for showS in the Prelude
> > for better ways to hook strings together.  Paul Hudak talks 
> about the
> > efficient use of the show functions at:
> > 
> >  http://www.haskell.org/tutorial/stdclasses.html
> > 
> > Now, with regard to the code being ugly, my suggestion would be to
> > check out some of the pretty printer libraries out there, 
> and to look
> > through them.  They basically solve a similar problem, except they
> > first parse a normal program into a tree, then flatten the tree in a
> > standard way.  In your case you'll likely build the tree directly,
> > then call the final stages of the pretty printer.  There is no
> > shortage of pretty printer libraries for Haskell, or for FP in
> > general.
> 
> The canonical approach is to define an internal data
> structure that represents C++ code, then let your mutator
> functions generate values of that data type (instead of
> strings), and finally pretty print values of this C++ data
> structure.  That's cleaner and more flexible than the ++
> cascades (or the show equivalent).
> 
> Depending on how restricted and/or idiomatic the generate
> C++ code is, it makes sense to not have a data structure
> that can represent arbitrary C++ programs, but only a subset
> that is relevant for the code generation task at hand.  So,
> you might want functions like
> 
>   mutatorDef :: ... -> AbstractCPlusPlus
> 
>   prettyPrintACPP :: AbstractCPlusPlus -> String
> 
> Cheers,
> Manuel
> 




Re: code generation for other languages

2000-08-23 Thread Manuel M. T. Chakravarty

Jeffrey Straszhiem <[EMAIL PROTECTED]> wrote,

> On Wed, Aug 23, 2000 at 12:26:38PM +1000, Timothy Docker wrote:
> > 
> > I'm writing a haskell program that generates C++ code based upon
> > some haskell data structures. At the moment, the code is somewhat
> > ugly with lots of stuff like
> > 
> > mutatorDef structName (name,vtype) = 
> > "inline void\n" ++
> > structName ++ "::" ++ (mutatorName name) ++
> > "( " ++ (cppParamType vtype) ++ " v ) {\n" ++
> > "" ++ (storageName name) ++ " = v;\n" ++
> > "}\n\n"
> > 
> > All those ++ operators working on raw strings bug me, and manually
> > getting the indentation correct is a pain. Is there a more
> > functional approach to generating source code? I thought this could
> > be a common enough task that there could be a library, but a perusal
> > of haskell.org didn't seem to show anything relevant.
> 
> To make matters worse, you're likely getting lousy efficiency with all
> of the ++ operators.  Look through the code for showS in the Prelude
> for better ways to hook strings together.  Paul Hudak talks about the
> efficient use of the show functions at:
> 
>  http://www.haskell.org/tutorial/stdclasses.html
> 
> Now, with regard to the code being ugly, my suggestion would be to
> check out some of the pretty printer libraries out there, and to look
> through them.  They basically solve a similar problem, except they
> first parse a normal program into a tree, then flatten the tree in a
> standard way.  In your case you'll likely build the tree directly,
> then call the final stages of the pretty printer.  There is no
> shortage of pretty printer libraries for Haskell, or for FP in
> general.

The canonical approach is to define an internal data
structure that represents C++ code, then let your mutator
functions generate values of that data type (instead of
strings), and finally pretty print values of this C++ data
structure.  That's cleaner and more flexible than the ++
cascades (or the show equivalent).

Depending on how restricted and/or idiomatic the generate
C++ code is, it makes sense to not have a data structure
that can represent arbitrary C++ programs, but only a subset
that is relevant for the code generation task at hand.  So,
you might want functions like

  mutatorDef :: ... -> AbstractCPlusPlus

  prettyPrintACPP :: AbstractCPlusPlus -> String

Cheers,
Manuel




Re: Higher-order function application

2000-08-23 Thread George Russell

Tim Sweeney wrote:
> However, a higher-order notion of function application seems sensible in
> many cases.  For example, consider the following expressions, which Haskell
> rejects, despite an "obvious" programmer intent:
Casting was done quite extensively by Algol68 (though not of this form).
A classic example: in the assignment
   x := y + 2
suppose that the values x and y are declared to be references to integer.  2 is of 
course
an integer.  Then y is implicitly dereferenced to get a pure integer.  Dereferencing
can occur any number of times.  Compare this with ML (using refs) or Haskell (using 
IORefs)
where you'd have to put a dereference to y in explicitly.

Other coercions were: you could use a value as if it were an array containing
that value; you could use a function of type (Haskell notation) 
 () -> A as if it were a value of type A (the function would implicitly be called) 
and so on. 

The rules for exactly what coercions can and can't be used exactly where in
Algol68 are extremely complicated.  (There are different contexts in which
different casts are permitted.)  However I used Algol68 to write quite a bit 
of code about 10 years ago and I usually found that it worked as I intuitively
expected, even though I didn't understand the rules.   

However in my own opinion I think that Haskell's type system and error messages
are already complicated enough; indeed probably too complicated.  I would not
favour extending Haskell to allow such friendly coercions.




Re: Higher-order function application

2000-08-23 Thread Bjorn Lisper

Tim Sweeney:
>Is this "higher order function application" a useful notion, and does any
>research exist on the topic?

The answer to the first question is "yes, when it matches the intuition of
the programmer". Your two first examples:

>cos+sin-- intent: \x->((cos x)+(sin x))
>cos(sin)   -- intent: \x->cos(sin(x))

have equivalents in Fortran 90 and HPF, although with arrays rather than
functions. For instance, one can write "A+B" to mean an array with value
A(I)+B(I) for all indices I, and A(B) for the array with elements A(B(I))
(provided B is an integer array whose elements all are valid indices for
A). This feature is widely used in array languages, where it is seen as an
intuitive and convenient notation to express array operations. I definitely
believe it could be useful also for operations over other data structures.

The answer to the second question is "surprisingly little". There is, for
instance, no formal description to be found of the Fortran 90 array
operations and how they type.  But it is quite straightforward to define
type systems and type checking algorithms for this, when the language is
explicitly typed. One example is

@InProceedings{Thatte-ScalingA,
  author =   {Satish Thatte},
  title ={Type Inference and Implicit Scaling},
  booktitle ={ESOP'90 -- 3rd European Symposium on Programming},
  editor =   {G. Goos and J. Hartmanis},
  number =   432,
  series =   {Lecture Notes in Computer Science},
  year = 1990,
  publisher ={Springer-Verlag},
  address =  {Copenhagen, Denmark},
  month =may,
  pages ={406--420}
}

where a type system for an APL-inspired overloading in an FP-like language
is described. This approach is based on subtyping.

A student of mine is pursuing another, more direct approach, where a
coercive type system is used to resolve the overloading at compile time
through a combined rewrite and type check. He did this for an explicitly
typed variant of Core ML, and this is reported in his Licentiate thesis
("file://ftp.it.kth.se/Reports/paradis/claest-licthesis.ps.gz"):

@PHDTHESIS{claest-lic,
AUTHOR = {Claes Thornberg},
TITLE = {Towards Polymorphic Type Inference with Elemental Function 
Overloading},
SCHOOL = it,
ADDRESS = {Stockholm},
YEAR = {1999},
TYPE = {Licentiate thesis},
MONTH = may,
NOTE = {Research Report } # rep-id # {99:03}
}

@STRING{it = "Dept.\ of Teleinformatics, KTH"}

@STRING{rep-id = "TRITA-IT R "}

When the type system is implicit (inference rather than checking), however,
less is known. You can do some tricks with the Haskell class system (for
instance, defining functions between instances of Num to be instances of
Num themselves, which then lets you overload numerical operations like "+")
but this solution has some restrictions and is also likely to lead to
run-time overheads. We would like to have something better.

Finally, there is an interesting discussion of this overloading business,
for array- and data parallel languages, in

@ARTICLE{Sip-Blel-Coll-Lang,
AUTHOR = {Jay M. Sipelstein and Guy E. Blelloch},
TITLE = {Collection-Oriented Languages},
JOURNAL = {Proc.\ {IEEE}},
YEAR = {1991},
VOLUME = {79},
NUMBER = {4},
PAGES = {504--523},
MONTH = apr
}

For instance, they bring up the possible conflicts which may occur when
trying to resolve this overloading for operations over nested data
structures. (A witness is length l, where l :: [[a]]: should it be just
length l, or resolved into map length l?)

Björn Lisper




RE: Higher-order function application

2000-08-23 Thread Andrew Kennedy

Something like this was proposed by Satish Thatte a while back; he called it
"implicit scaling". See

S. Thatte. A type system for implicit scaling. Science of computer
programming, 17:217--245, 1991. 

S. Thatte. Type inference and implicit scaling. In European Symposium on
Programming. Springer Verlag LNCS 432, 1990. 

Unfortunately neither appear to be available online.
- Andrew.

> -Original Message-
> From: Tim Sweeney [mailto:[EMAIL PROTECTED]]
> Sent: Wednesday, August 23, 2000 7:37 AM
> To: [EMAIL PROTECTED]
> Subject: Higher-order function application
> 
> 
> In Haskell, only a single notion of "function application" 
> exists, where a
> function f::t->u is passed a parameter of type t, returning a 
> result of type
> u.  Example function calls are:
> 
> 1+2
> sin 3.14
> map sin [1:2:3]
> 
> However, a higher-order notion of function application seems 
> sensible in
> many cases.  For example, consider the following expressions, 
> which Haskell
> rejects, despite an "obvious" programmer intent:
> 
> cos+sin-- intent: \x->((cos x)+(sin x))
> cos(sin)   -- intent: \x->cos(sin(x))
> (cos,sin)(1,2) -- intent: cos(1),sin(2)
> (+)(1,2)   -- intent: (+)(1)(2)
> cos [1:2:3]-- intent: map cos [1:2:3]
> 
> From this intuition, let's postulate that it's possible for a 
> compiler to
> automatically accept such expressions by translating them to the more
> verbose "intent" listed above, using rules such as:
> 
> 1. Operator calls like (+) over functions translate to lambda 
> abstractions
> as in the "cos+sin" example.
> 
> 2. A pair of functions f::t->u, g::v->w acts as a single 
> function from pairs
> to pairs, (f,g)::(t,u)->(v,w).
> 
> 3. Translating function calling into function composition, 
> like "cos(sin)".
> 
> 4. Automatic currying when a pair is passed to a curried function.
> 
> 5. Automatic uncurrying when a function expecting a parameter 
> of type (t,u)
> is passed a single value of type t.
> 
> 6. Applying a function f:t->u to a list x::[t] translates to 
> "map f x".
> 
> I wonder, are these rules self-consistent?  Are they 
> unambiguous in all
> cases?  Are there other rules we can safely add?
> 
> It also seems that every statement above is simply a new 
> axiom at the type
> checker's disposal.  For example, to describe the general notion of
> "cos+sin" meaning "\x->(cos(x)+sin(x))", we say:
> 
> for all types t,u,v,
> for all functions f,g :: t->u,
> for all functions h ::u->u->v,
> h (f,g) = \x->h(f(x),g(x)).
> 
> Is this "higher order function application" a useful notion, 
> and does any
> research exist on the topic?
> 
> -Tim
> 
> 




Re: Higher-order function application

2000-08-23 Thread D. Tweed

> Tim> 6. Applying a function f:t->u to a list x::[t] translates to
> Tim> "map f x".

This can be done in mathematica via function attribute (Listable if my
memory is correct). IIRC It's defined by default only for functions that
only make sense on pure numbers/symbols (eg Sin) and it's very convenient
when working interactively on expressions a few levels deep. It's also one
of the things that makes building bigger programs in Mathematica a very
error prone business. I agree with the others who've said it's probably
not appropriate or implementable for a compiled, typed language like
Haskell.

___cheers,_dave
www.cs.bris.ac.uk/~tweed/pi.htm|tweed's law:  however many computers
email: [EMAIL PROTECTED] |you have, half your time is spent
work tel: (0117) 954-5250  |waiting for compilations to finish.






Re: Higher-order function application

2000-08-23 Thread Andreas Rossberg

"Ch. A. Herrmann" wrote:
> 
> the problem is that we loose much of the strength the Haskell type
> system provides and a lot of programming errors will remain
> undetected.

Moreover, it is completely incompatible with polymorphic typing and type
inference, because you overload notation. Consider for example a
definition like

f x y = x y

How do you want to type this if actually application syntax can mean
many different things? Using your rules, f could be typed

f :: (a -> b) -> a -> b
f :: (a -> b) -> (c -> a) -> (c -> b)
f :: (a -> b, c -> d) -> (a,c) -> (b,d)
f :: (a -> b -> c) -> (a,b) -> c
f :: (a -> b) -> [a] -> [b]
...

all of which are incompatible. Also note that operators like (+) usually
have no special status in functional languages, they are ordinary
functions. So giving them special typing rules is a bad idea. Similarly,
types like [] should have no special meaning besides being predefined.

It's better to say what you mean, overloading is your enemy! (Well, not
counting Haskell style "overloading" through type classes, which I
wouldn't call overloading in the first place.) BTW, this sort of
notational overloading used in maths has always been a good source of
confusion for students, IMHO.

All the best,

- Andreas

-- 
Andreas Rossberg, [EMAIL PROTECTED]

:: be declarative. be functional. just be. ::




Re: Higher-order function application

2000-08-23 Thread Adrian Hey

Hello,

On Wed 23 Aug, Tim Sweeney wrote:

> Is this "higher order function application" a useful notion,

Eeek!, no IMHO 

> and does any research exist on the topic?

I suspect not, though I must admit I'm no expert on what's being researched
in the world.

What scares me about this is that even if it were possible to produce
a compiler which disambiguated such expressions using complex rules, that's
not enough. You (we) as a programmer also need to understand those rules
and apply them to make sure the program you get is what you intended.

I think its much better to stick with the philosopy of writing down exactly
what you mean. Unless your proposal enables functions to be defined which
are currently undefinable in Haskell, I'd say forget it. Sorry :-(

P.S. This is also why I'm not entirely happy with using the type system
to resolve ambiguities caused by overloading. It makes programs harder
to understand IMHO. But people who think this way seem to be in a
minority, so maybe your proposal will get the approval of somebody other
than me :-)

Regards
-- 
Adrian Hey





Re: Higher-order function application

2000-08-23 Thread Ch. A. Herrmann

Hi Tim,

Tim> 6. Applying a function f:t->u to a list x::[t] translates to
Tim> "map f x".

the problem is that we loose much of the strength the Haskell type
system provides and a lot of programming errors will remain
undetected.

What you can do is write a preprocessor that provides a
nicer syntax for you.

Cheers
-- 
 Christoph Herrmann
 E-mail:  [EMAIL PROTECTED]
 WWW: http://brahms.fmi.uni-passau.de/cl/staff/herrmann.html