Re[4]: [Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Bulat Ziganshin
Hello Nicolas,

Wednesday, November 8, 2006, 1:25:23 AM, you wrote:

   prec ??  $
 over-specification). You want ?? to bind more tightly than does $;
 that's exactly what this approach would let you specify.

and how then compiler will guess that is relational priority of this
operator comparing to '$!' ? :)


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Joachim Durchholz

David House schrieb:

Also, it provides an infinite space for fixities. I think the problem
'binds tighter than X but not as tight as Y', where X and Y are only
fixity integer apart is somewhat common, and this would fix it. It
would allow for extensibility into the future, where the operator
space will only become more dense, and maintaining a complete order
with only 10 integers to play will become more and more difficult.
Allowing an infinite amount of operators to come between any two
operators sounds like a solid design decision to me.


Yes, but allowing simply to specify some ordering relationship to 
existing operators is an even more solid one.


Fractional fixities are overspecification, and this can hurt in 
scenarios like this one:


Developer A creates an operator with this fixity declaration:
  infixl 6.25  +*
Developer B has this:
  infixl 6.75 *+
(They don't use 6.5 because each has another operator at 6.5 already.)

Now when some developer mixes +* and *+ in the same expression, the 
compiler will automatically assign a relative priority for the two 
operators, even though it's not at all clear whether the two operators 
have any relative precedence - it would be far preferable if the 
compiler simply declared nonpriority and emitted an error, forcing the 
programmer to clearly state what priorities he had in mind when writing 
down the expression.


I know the above example is a bit far-fetched. And it's not a really 
important issue anyway.


Regards,
Jo

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


RE: Re: [Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Simon Marlow
Nicolas Frisby wrote:
 Let's remember that if something is broke, it's only _right_ to _fix_
 it. I patiently waited for someone else to make that pun.

 Understanding the language won't be much harder, but understanding
 fixity declarations will become a task. Consider:

 infixl -1.7521  -- what and why?

 As the operator space becomes more dense, negative and fractional
 fixities are going to become more obfuscated. The negative and
 fractional fixities will satisfy a number purposes well, but they will
 also be abused and lead to confusion.

 This smells like a wart growing on a wart to me.

All these are valid points.  However, given that we can't completely redesign, 
implement and test a new fixity system in time for Haskell', it makes sense to 
make a simple change that unambiguously improves the current system, and is no 
more difficult to implement (in fact, I bet it adds zero lines of code to the 
compiler).

Cheers,
Simon


 Nick

 On 11/7/06, David House [EMAIL PROTECTED] wrote:
 On 07/11/06, Jon Fairbairn [EMAIL PROTECTED] wrote:
 I must say though, that I don't like the reasoning that we
 can put in fractional fixities because it's a small
 change. The way to hell is through a series of small
 steps. If using integers to express fixities is a bit of a
 hack, switching to rational numbers is a hack on top of a
 hack.

 Well, It's a _conceptually_ simple idea, one that doesn't make
 understanding the language much harder.

 Also, it provides an infinite space for fixities. I think the problem
 'binds tighter than X but not as tight as Y', where X and Y are only
 fixity integer apart is somewhat common, and this would fix it. It
 would allow for extensibility into the future, where the operator
 space will only become more dense, and maintaining a complete order
 with only 10 integers to play will become more and more difficult.
 Allowing an infinite amount of operators to come between any two
 operators sounds like a solid design decision to me.

 --
 -David House, [EMAIL PROTECTED]
 ___
 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


[Haskell-cafe] StateT and modify

2006-11-08 Thread Peter Steiner

hi haskellers,

i have a basic question regarding StateT encapsulating IO and the
modify function.

my scenario is similar to the following simple code snippet:


import Control.Monad.State

type MyState = StateT Int IO

test = evalStateT foo 0

foo = do
   modify $ (+) 1
   get


i would like to be able to debug what's happening inside the modifier
function. that's why i want to be able to use a modifier that's in the
IO monad, like in the following, obviously defunct snippet:


test = evalStateT bar 0

bar = do
   modify $ myAdd 1
   get

myAdd :: Int - Int - IO Int
myAdd x y = do
   putStr in myAdd\n
   return $ x + y


this fails because (myAdd :: Int - Int - IO Int) does not match the
required modify argument type (Int - Int - Int) for MyState.

   Couldn't match expected type `Int' against inferred type `IO Int'
   In the second argument of `($)', namely `myAdd 1'
   In the expression: modify $ (myAdd 1)
   In a 'do' expression: modify $ (myAdd 1)

is it possible to 'lift' StateT modify into the inner monad (IO in my case)?

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


Re: [Haskell-cafe] StateT and modify

2006-11-08 Thread Cale Gibbard

bar = do
  x - get
  y - lift $ myAdd 1 x
  put y
  return y

If you want, you can write something which captures this idiom:

liftModify c = do
   x - get
   y - lift (c x)
   put y

and then use that like:

bar = do
  liftModify (myAdd 1)
  get

On 08/11/06, Peter Steiner [EMAIL PROTECTED] wrote:

hi haskellers,

i have a basic question regarding StateT encapsulating IO and the
modify function.

my scenario is similar to the following simple code snippet:

 import Control.Monad.State

 type MyState = StateT Int IO

 test = evalStateT foo 0

 foo = do
modify $ (+) 1
get

i would like to be able to debug what's happening inside the modifier
function. that's why i want to be able to use a modifier that's in the
IO monad, like in the following, obviously defunct snippet:

 test = evalStateT bar 0

 bar = do
modify $ myAdd 1
get

 myAdd :: Int - Int - IO Int
 myAdd x y = do
putStr in myAdd\n
return $ x + y

this fails because (myAdd :: Int - Int - IO Int) does not match the
required modify argument type (Int - Int - Int) for MyState.

Couldn't match expected type `Int' against inferred type `IO Int'
In the second argument of `($)', namely `myAdd 1'
In the expression: modify $ (myAdd 1)
In a 'do' expression: modify $ (myAdd 1)

is it possible to 'lift' StateT modify into the inner monad (IO in my case)?

regards,
peter.
___
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


[Haskell-cafe] Re: Livecoding music in Haskell

2006-11-08 Thread Rohan Drape
On Tue Nov 7 16:32:11 EST 2006, alex wrote:
 The way I see it there are two big issues - the first is drift and the
 second is latency.

As hinted at when Alex's work was discussed last November:

  OSC messages can be timestamped, and SuperCollider has a sample
  accurate scheduling queue, so language timing jitter can easily be
  worked around.

  http://www.haskell.org/pipermail/haskell-cafe/2005-November/012483.html

Currently Sound.SC3 has a procedure 'at' that can be used for
scheduling.

This procedure doesn't really belong in Sound.SC3, and ought probably
be taken out.

Still, with the current darcs repository the following makes a ping
every second, on the second, sample accurately, for half a minute.  If
you run the binary twice the pings will be twice the amplitude, no
phase errors - fingers crossed.

import Sound.SC3
import Control.Concurrent (forkIO)

ping f a = out 0 (sinOsc AR f 0 * e)
 where c = EnvNum (-4.0)
   e = envGen KR 1 a 0 1 removeSynth (envPerc 0.1 0.6 1 [c,c])

latency = 0.01

bundle t m = OscB (t + latency) m

pinger = do now - utc
at (fromIntegral (ceiling now)) f
where f t = do fd - sc
   send' fd (bundle t [s_new ping (-1) AddToTail 1])
   putStrLn Sending ping
   return 1.0

main = do fd - sc
  putStrLn Sending Ping Instrument
  sync' fd (d_recv' ping (ping 440 0.1))
  putStrLn Resetting scsynth
  reset fd
  putStrLn Starting schedule thread
  forkIO pinger
  putStrLn Delaying main thread
  pause 30
  putStrLn End of delay, exiting

The above assumes that scsynth is running on the local host at the
standard port, 57110, and that the GHC runtime scheduler jitter plus
localhost network latency for this task is below 0.01 seconds, which
is true on my otherwise idle X31 at 600MHz - this is not at all bad, I
am impressed in any case - setting latency to zero gives reports from
scsynth of:

 late 0.008414722
 late 0.006882722
 late 0.005348722
 late 0.003815721
 late 0.002282721
 late 0.000748721

Tacked on below, for interested readers, are some notes on a related
scheme scheduler, the notes were written in response to a related
query about scheme  scsynth some time ago.  The relation to the
haskell above is pretty straightforward, the haskell 'at' discards the
notion of a mutable schedule - with cheap concurrency such a thing is
of arguable use - and the haskell 'at' ought to allow the event
generator to return Nothing to stop scheduling.

Regards,
Rohan

++

Simple sample accurate scheduling from runtimes with moderate
scheduling jitter is straightforward using SuperCollider.

One simple model is:

(at Q TIME (lambda (t f) (EVENT t) (f DELTA)))

at  = the scheduler interface
Q   = a schedule value
TIME= a UTC timestamp
t   = the scheduled UTC time (ie. TIME or subsequent delta),
  regardless of when the procedure actually runs
f   = a rescheduling function that in effect does
  (at Q (+ t DELTA) *SELF*)
EVENT   = the action, usually constructs an osc bundle and
  sends it to scsynth
DELTA   = the delta time to reschedule to, to not re-schedule
  just don't call f

The EVENT sends a bundle to scsynth and adds latency as required so
that the scheduled bundle arrives ahead of the timestamp, the actual
sample-accurate scheduling is handled by a queue at scsynth.

The example below will schedule a ping at each whole second, and the
scheduling will be sample accurate so long as the scheme runtime
jitter is less than 0.1 seconds minus the network latency to get a UDP
packet to the scsynth address.

Here (utc) gets the current time, (- s p) sends an OSC packet p to
the server s, (/s_new ...) makes a /s_new OSC message,  (bundle t m)
makes an OSC packet converting the UTC timestamp to NTP.

(define s (open-udp* 127.0.0.1 57110))
(define Q (make-schedule*))
(define L 0.1)

(define (ship t m) (- s (bundle (+ t L) m)))

(at
  Q (ceiling (utc))
  (lambda (t f)
(ship t (/s_new ping -1 1 1))
(f 1.0)))

Obviously to schedule just one ping in five seconds time:

(at Q (+ (utc) 5) (lambda (t _) (ship t (/s_new ping -1 1 1

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


Re: [Haskell-cafe] StateT and modify

2006-11-08 Thread Bulat Ziganshin
Hello Peter,

Wednesday, November 8, 2006, 1:48:24 PM, you wrote:

 i would like to be able to debug what's happening inside the modifier
 function. that's why i want to be able to use a modifier that's in the
 IO monad

for debugging there is 'trace' function which don't needs IO monad

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


[Haskell-cafe] Fun with Num instances of functions

2006-11-08 Thread Henning Thielemann

Some people have argued, that Num instances of (-) would be nice in order
to add functions nicely, say for
  f, g :: Num a = b - a
   you would define
  (f+g) x = f x + g x

With an according definition of fromInteger
  fromInteger = const
numeric literals would also denote constant functions. This allows
  f+2  ==  \x - f x + 2 .

Even nicer, the mathematically established notation of omitting the
multiplication dot
  2(x+y) :: Integer
 will now be parsed by a Haskell compiler to the most obvious meaning
  2 :: Integer
 !

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


[Haskell-cafe] Re: Livecoding music in Haskell

2006-11-08 Thread Rohan Drape
On Tue Nov 7 16:32:11 EST 2006, alex wrote:
 Latency I deal with by calculating everything a second or so ahead of
 time, and timestamping my OSC packets with times in the future.  Then on
 the other side I have some scheduling stuff to trigger sounds at the
 right moment, for example in SuperCollider's sclang:

A second seems excessive?  Working directly with ghc - scsynth
latencies of ~ 0.075 do not seem to be and issue with even relatively
heavy scheduling loads.

   response = { 
 arg time, responder, message; 
 if (message[1] == 'on',
   {
 SystemClock.sched(time - Date.getDate.rawSeconds,
   {Synth(noisebox,
  [\lgain,message[2] / 100,
   \rgain,message[3] / 100,
   \ts,   message[4] / 100,
   \browndel, message[5] / 100,
   \filter,   message[6],
   \envtype,  message[7]
  ]
 ); nil;
   };
 );
   });
 };
 o = OSCresponder(nil, '/noise', response);
 o.add;

Even sclang, remarkable as it is, will need to be sending time-stamped
bundles for reliable sample-accurate timing?  Even to avoid
perceptible jitter under high load?

Regards,
Rohan

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


[Haskell-cafe] Re: ANN: System.FilePath 0.10

2006-11-08 Thread Simon Marlow

Neil Mitchell wrote:


ANNOUNCEMENT:

I am hereby announcing System.FilePath 0.10, which hopefully is pretty
close to final now. This library manipulates FilePath's correctly on
both Posix and Windows.

http://www-users.cs.york.ac.uk/~ndm/projects/libraries.php#filepath

(Includes a darcs repo, a .tar.gz, haddock documentation etc)

In this version I have made reasonably large changes:

* Lots of functions gone (temporary file handling, canonicalization,
drive manipulation, directory creation,  directory enumeration) -
pretty much down to only pure (non-IO methods) left.

* 3 new methods (asFile, isFile, asDirectory - look up the docs for
their meanings, but they are pretty small)

* Renamed functions to follow the scheme replace/take/drop instead of
set/get/drop - as suggested by Simon Marlow (since set/get implies
state operations in Haskell)


Looks good! I have a few small further suggestions:

  - remove addFileName: it does the same thing as combine, or rather
the difference is subtle and not mentioned in the docs.  It's
subsumed by combine, anyway.

  - remove isDirectory.  I think its presence is confusing, e.g
forall x. isDirectory (takeDirectory x) == False!
Also it's not really correct; /bin/ means something subtly different to
/bin on Unix systems.  Similarly isFile, asFile, asDirectory could
be removed, I think.

  - Use the terminology search path consistently for anything to
do with $PATH. i.e.
fileSeparator = searchPathSeparator,
isFileSeparator = isSearchPathSeparator,
splitFiles = splitSearchPath
also, move fileSeparator, isFileSeparator into the $PATH section
in the docs (or change basic functions to separator predicates).

  - remove splitPath: splitDirectories is enough.  I'd rename it
to splitPathComponents, though.

  - shortPath = relativeToCurrentDirectory
shortPathWith = makeRelativePath

Cheers,
Simon

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


Re: [Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Bertram Felgenhauer
Simon Marlow wrote:
 http://hackage.haskell.org/cgi-bin/haskell-prime/trac.cgi/wiki/FixityResolution

What's the fate of unary minus under that proposal?
In the Haskell report its syntax is part of the lexp^6 production.

This production makes it possible to write (-1+) instead of (subtract 1),
although that's not really advisable because Hugs fails to parse (-1+).
Interestingly, hugs allows (+ -1) instead, but I believe that's wrong.

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


Re: [Haskell-cafe] Re: Livecoding music in Haskell

2006-11-08 Thread alex
On Wed, 2006-11-08 at 22:35 +1100, Rohan Drape wrote:
 A second seems excessive?  Working directly with ghc - scsynth
 latencies of ~ 0.075 do not seem to be and issue with even relatively
 heavy scheduling loads.

Yes you're right, although with my current timescales of livecoding, an
extra second of latency doesn't make much difference.  I'm not dealing
with individual notes, but longer term structures.

 Even sclang, remarkable as it is, will need to be sending time-stamped
 bundles for reliable sample-accurate timing?  Even to avoid
 perceptible jitter under high load?

Ah, good point - so I am falsely conflating sclang with scsynth?  I am
(still) a beginner sclang programmer as well as a beginner haskell
programmer.  In any case I intend to move to your hsc library soon, so
thanks for the scheduling details in your other mail.

Thanks also to those pointing me at Haskore on #haskell, so far it looks
a lot like my existing representation of music, only much better.


alex


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


Re: [Haskell-cafe] Re: Livecoding music in Haskell

2006-11-08 Thread alex

I meant to add that of course once you have sample-accurate timing, the
next job is to mess things up again with some model of expression in
performance (unless you're making german techno).  

For example I intend to apply some of these rules within Haskore as part
of my project:
  http://www.speech.kth.se/music/performance/performance_rules.html

The alternative to this is to stick with a flawed system and decide that
it's expressive :)  Relatedly, one thing I dislike about supercollider
(or at least the way I'm using it right now) is that its failure mode is
to crash rather than produce inaccurate output.  To me part of the
enjoyment of an instrument is  what happens when you go beyond its
normal limits.

alex


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


Re: [Haskell-cafe] StateT and modify

2006-11-08 Thread Peter Steiner

On 11/8/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:

Hello Peter,

Wednesday, November 8, 2006, 1:48:24 PM, you wrote:

 i would like to be able to debug what's happening inside the modifier
 function. that's why i want to be able to use a modifier that's in the
 IO monad

for debugging there is 'trace' function which don't needs IO monad


thanks. i am aware of trace, but the potentially messed up execution
order makes it very hard for me to get useful information out of the
resulting trace. besides, IO will scale to more elaborate logging
mechanisms later on...

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


[Haskell-cafe] Re: ANN: System.FilePath 0.10

2006-11-08 Thread Neil Mitchell

Hi Simon,


   - remove addFileName: it does the same thing as combine, or rather
 the difference is subtle and not mentioned in the docs.  It's
 subsumed by combine, anyway.


The difference is subtle:

System.FilePath addFileName test c:\\
test\\c:\\
System.FilePath combine test c:\\
c:\\

I'm coming around to the idea that addFileName is subtly different and
entirely wrong, so yes, removing it seems fine.



   - remove isDirectory.  I think its presence is confusing, e.g
 forall x. isDirectory (takeDirectory x) == False!
 Also it's not really correct; /bin/ means something subtly different to
 /bin on Unix systems.  Similarly isFile, asFile, asDirectory could
 be removed, I think.


The reason I have them is because there are some circumstances where
they are required in some programs. For example the behaviour of cp
is different depending on whether the item is given as a file or a
directory - hence these methods abstract away testing for that
difference. I will think about this.


   - Use the terminology search path consistently for anything to
 do with $PATH. i.e.
 fileSeparator = searchPathSeparator,
 isFileSeparator = isSearchPathSeparator,
 splitFiles = splitSearchPath


Ok, makes sense - I viewed it as a collection of files, of which one
instance is a search path. I guess in reality this will be the only
collection of files so the name should reflect this.


 also, move fileSeparator, isFileSeparator into the $PATH section
 in the docs (or change basic functions to separator predicates).


Renaming basic functions to separator predicates is easy enough. I'd
rather leave these predicates in a separate section so people are less
inclined to use them - they are the building blocks that the higher
level functionality is based on.


   - remove splitPath: splitDirectories is enough.  I'd rename it
 to splitPathComponents, though.


splitPath has the nice property that you can join it back together
again with the right file separators:

(\\ == \ since its escaped in a string)

System.FilePath joinPath $ splitPath test/file\\more
test/file\\more
System.FilePath joinPath $ splitDirectories test/file\\more
test\\file\\more

This allows the developer to keep the FilePath more as the user
specified. Maybe its not worth it though.


   - shortPath = relativeToCurrentDirectory
 shortPathWith = makeRelativePath


I like them having the same prefix, it makes them more related in some
way. makeRelative and makeRelativeToCurrentDirectory seem more natural
to me. However, I'm not overly fussed.

I've updated the way the versions of the FilePath library are
organised, so once everyone's finished discussing this I'll try and
get a 0.11 out in the next week that addresses these issues.

Thanks

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


[Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Henning Thielemann

On Wed, 8 Nov 2006, Bulat Ziganshin wrote:

 Hello Nicolas,
 
 Wednesday, November 8, 2006, 1:25:23 AM, you wrote:
 
prec ??  $
  over-specification). You want ?? to bind more tightly than does $;
  that's exactly what this approach would let you specify.
 
 and how then compiler will guess that is relational priority of this
 operator comparing to '$!' ? :)

(What might the smiley mean?)

It could not guess it, and this is good! However, if in the Prelude it is 
defined, that ($) and ($!) have the same precedence, then the 
compiler could derive automatically that prec ??  $!.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Henning Thielemann

On Tue, 7 Nov 2006, David House wrote:

 On 07/11/06, Jon Fairbairn [EMAIL PROTECTED] wrote:
  I must say though, that I don't like the reasoning that we
  can put in fractional fixities because it's a small
  change. The way to hell is through a series of small
  steps. If using integers to express fixities is a bit of a
  hack, switching to rational numbers is a hack on top of a
  hack.
 
 Well, It's a _conceptually_ simple idea, one that doesn't make
 understanding the language much harder.
 
 Also, it provides an infinite space for fixities. I think the problem
 'binds tighter than X but not as tight as Y', where X and Y are only
 fixity integer apart is somewhat common, and this would fix it.

In school we learnt dot operations (multiplication, division) bind more
tightly than dash operations (addition, subtraction). I imagine we would
have learnt dot operations have precedence 7, dash operations have
precedence 6. :-)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Fractional/negative fixity?

2006-11-08 Thread Robert Dockins


On Nov 8, 2006, at 3:58 AM, [EMAIL PROTECTED] wrote:


Lennart Augustsson wrote:


On Nov 7, 2006, at 11:47 ,
[EMAIL PROTECTED] wrote:


Henning Thielemann wrote:

On Tue, 7 Nov 2006, Simon Marlow wrote:

I'd support fractional and negative fixity.  It's a simple  
change to

make, but we also have to adopt

[...]


I think that computable real fixity levels are useful, too. A  
further
step to complex numbers is not advised because those cannot be  
ordered.


But ordering of the computable reals is not computable.  So it could
cause the compiler to loop during parsing. :)


Actually, that's one of the use cases ;)


A turing-complete type-checker isn't enough!  Our work is not  
complete until the parser is a universal machine as well!




Regards,
apfelmus



Rob Dockins

Speak softly and drive a Sherman tank.
Laugh hard; it's a long way to the bank.
  -- TMBG



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


[Haskell-cafe] Re: Fractional/negative fixity?

2006-11-08 Thread Nils Anders Danielsson
On Wed, 08 Nov 2006, Arie Peterson [EMAIL PROTECTED] wrote:

 Specifying precedence 'lazily', by a partial order, does not suffer from
 this problem, because it only requires you to make local decisions.

Assuming we only want to be able to make local decisions.

Let's say that we want == to bind less tightly than +, as it is now.
Let's also say that Eq and Num are defined in two different
_unrelated_ modules (this of course implies that Eq is not a
superclass of Num). Where and how would we specify the relation
between these two operators?

-- 
/NAD

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


[Haskell-cafe] Newbie Q: composeMaybe :: (a - Maybe b) - (b - Maybe c) - (a - Maybe c)

2006-11-08 Thread Dmitri O.Kondratiev

I am trying to solve a problem from The Craft of Functional Programming book:

14.38 ... define the function:
data Maybe a = Nothing | Just a
composeMaybe :: (a - Maybe b) - (b - Maybe c) - (a - Maybe c)

using functions:

squashMaybe :: Maybe (Maybe a) - Maybe a
squashMaybe (Just (Just x)) = Just x
squashMaybe _ = Nothing

mapMaybe :: (a - b) - Maybe a - Maybe b
mapMaybe f Nothing = Nothing
mapMaybe f (Just x) = Just (f x)

As a first step to the solution I defined auxilary function:
f1 f g x = mapMaybe f (g x)

GHCi gives the following type for this function:

f1 :: (a - b) - (t - Maybe a) - t - Maybe b
 ^^^
Q: I don't quite understand this signature. I would expect this
instead (by mapMaybe definition):
f1 :: (a - b) - (t - Maybe a) - Maybe b


From where does the second 't' come from? What are the arguments and

what f1 returns in this case?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Fractional/negative fixity?

2006-11-08 Thread Henning Thielemann

On Wed, 8 Nov 2006, Nils Anders Danielsson wrote:

 On Wed, 08 Nov 2006, Arie Peterson [EMAIL PROTECTED] wrote:
 
  Specifying precedence 'lazily', by a partial order, does not suffer from
  this problem, because it only requires you to make local decisions.
 
 Assuming we only want to be able to make local decisions.
 
 Let's say that we want == to bind less tightly than +, as it is now.
 Let's also say that Eq and Num are defined in two different
 _unrelated_ modules (this of course implies that Eq is not a
 superclass of Num). Where and how would we specify the relation
 between these two operators?

Depends on what we consider being more special.
 * Does addition require comparison? Not in Haskell. However, the
   recursive implementation of addition for Peano numbers need equality
   check.
 * Provide all additive types comparison? No.
 * Does comparison require addition? No.

 So, these concepts seem to be unrelated at first. If the Prelude would be
splitted into modules, where (==) and (+) are separated, and no module
imports the other one, then we need a third module, which states the
relation between (==) and (+). If I have missed something, and say (+)'s
module imports (==)'s one, then (+)'s module should define the relation.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: Re[4]: [Haskell-cafe] Fractional/negative fixity?

2006-11-08 Thread Nicolas Frisby

Well let's see. First I'll assume that

prec $! = $

is how $! was specified. Thus we know both ??  $ and $! = $. Let's
derive the relation between ?? and $!

??  $
= ??  $!{$ = $!}

So I think that is pretty straight-forward. :) is a parse error... ;)

This does bring up the interesting case where we want an operator
between $ and $! (or some less offensive pair of operators with equal
precedence). This, like Danielsson's later post, is a case that
deserves some thought. If we handle such cases in a consistent way, I
think we might have something quite useful.

On the positive side, when I want $! to behave like $ (or perhaps more
appropriately =*= to behave like ==) then I don't have to lookup the
numeric precedence of $ (or ==). I can just say

prec $! = $

and be done with it. There's no arbitrary middle man.

Nick


On 11/8/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:

Hello Nicolas,

Wednesday, November 8, 2006, 1:25:23 AM, you wrote:

   prec ??  $
 over-specification). You want ?? to bind more tightly than does $;
 that's exactly what this approach would let you specify.

and how then compiler will guess that is relational priority of this
operator comparing to '$!' ? :)


--
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



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


[Haskell-cafe] Re: Fractional/negative fixity?

2006-11-08 Thread Jón Fairbairn
Simon Marlow [EMAIL PROTECTED] writes:

 Nicolas Frisby wrote:
  Let's remember that if something is broke, it's only _right_ to _fix_
  it. I patiently waited for someone else to make that pun.
 
  Understanding the language won't be much harder, but understanding
  fixity declarations will become a task. Consider:
 
  infixl -1.7521  -- what and why?
 
  As the operator space becomes more dense, negative and fractional
  fixities are going to become more obfuscated. The negative and
  fractional fixities will satisfy a number purposes well, but they will
  also be abused and lead to confusion.
 
  This smells like a wart growing on a wart to me.
 
 All these are valid points.  However, given that we can't
 completely redesign, implement and test a new fixity
 system in time for Haskell',

...the correct thing to do is to leave it alone, rather than
make a change that addresses only one of the problems.

 it makes sense to make a simple change that unambiguously
 improves the current system,

I dispute that. It does make it possible to introduce a new
operator between two others, but on its own, that strikes me
as as likely to be a new problem as an improvement because
of the difficulty of remembering numeric precedences. It's
bad enough with the present number, let alone a countable
infinity of them.

The biggest flaw in the present system (and something I
wanted to address in my original proposal way back when) is
that there is no way to state that there is /no/ precedence
relationship between two operators. It would be far better
to have the compiler give an error message saying that an
expression needs some parentheses than have it choose the
wrong parse.

The next smaller flaw is that numeric precedences are a poor
match for the way we think.  I can easily remember that (*)
binds more tightly than (+), or that (+) beats (:) (though
the latter is slightly less obviously correct), but I don't
remember the numbers so when I want to define something new
that has a similar precedence to (*) (some new kind of
multiplication), I have to look it up, which is tedious.

Wanting to insert an operator between two others comes lower
in importance even than that, because in many cases giving
it the same precedence as something and appropriate
associativity gets you most of the way there.  It bites
because you can't say you want an error if you use it next
to something else without parentheses.

Let me throw out a couple of possibilities differing only in
syntax (one of my fears is that if we get fractional
fixities the other problems will be forgotten, so a real
improvement will never be discussed).  I don't expect either
of them to go into Haskell', but putting them forward might
encourage further discussion and discourage introduction of
something temporary that will stay with us forever.  

Syntax 1, based on Phil Wadler's improvement of my old
proposal. The precedence relation is a preorder.

infix {ops_1; ops_2; ...; ops_n}

(where each ops is a collection of operators optionally
annotated with L or R) would mean that each operator in
ops_i binds more tightly than all the operators in ops_j for
ji. (and we require ops_i `intersect` ops_j = empty_set for
i/=j) Layout rule applies for {;...}. An op can be a varsym
or a backquoted varid.

It says nothing about the relationship between the those
operators and operators not mentioned, except by virtue of
transitivity. So

infix R ^
  L * /
  L + -

would replicate the current relationships between those
arithmetic operators. An additional declaration

infix +
  R :

says that (+) binds more tightly than (:) and by
transitivity, so do (^ * and /). The associativity label
obviously has to be the same for all occurrences of an
operator in scope, so omitting it just says that it's
specified elsewhere.

infix *
  R @+ @-
  +

says that (@+) and (@-) fall between (*) and (-), and that
(a @+ b @- c) parses as (a @+ ([EMAIL PROTECTED])) but

infix * 
  R @@

says that (a * b @@ c @@ d) parses as ((a*b) @@ (c@@d)) but
leaves (a + b @@ c) undefined (a compile time error) unless
another declaration specifies it elsewhere. And

infix R @@ @@@

says nothing about the relationship between @@ or @@@ and
other operators, but indicates that they associate to the
right individually and together.


The alternative syntax is exemplified thus:

infix L + - (L * / (R ^))

The precedence increases the more deeply you go into the
parentheses. Arguably this is more suggestive and avoids the
possibility of reading precedences as increasing down the
page (danger of endianism argument cropping up there!), but
may be harder to read.

With both syntaxes there's no reason to reserve L and R,
since the context disambiguates.

For exports (imports) you pass the graph of the relation
with the unexported (unimported) operators omitted.

 and is no more difficult to implement (in fact, I bet it
 adds zero lines of code to the compiler).

If ease of implementation had been a 

[Haskell-cafe] Re: StateT and modify

2006-11-08 Thread Max Vasin
 Peter == Peter Steiner [EMAIL PROTECTED] writes:

Peter On 11/8/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:
 Hello Peter,
 
 Wednesday, November 8, 2006, 1:48:24 PM, you wrote:
 
  i would like to be able to debug what's happening inside the
 modifier  function. that's why i want to be able to use a
 modifier that's in the  IO monad
 
 for debugging there is 'trace' function which don't needs IO
 monad

Peter thanks. i am aware of trace, but the potentially messed up
Peter execution order makes it very hard for me to get useful
Peter information out of the resulting trace. besides, IO will
Peter scale to more elaborate logging mechanisms later on...

If all you want from IO is logging why not just use MonadWriter?

-- 
WBR,
Max Vasin.

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


[Haskell-cafe] Re: Fractional/negative fixity?

2006-11-08 Thread Nils Anders Danielsson
On Wed, 08 Nov 2006, Henning Thielemann [EMAIL PROTECTED] wrote:

 If the Prelude would be splitted into modules, where (==) and (+)
 are separated, and no module imports the other one, then we need a
 third module, which states the relation between (==) and (+).

Yes, presumably. However, currently a fixity declaration for an
operator can only be given in the module where the operator is
defined. In this hypothetical new system, how would one import/export
fixity declarations? Should they be named, or should they be treated
like instance declarations are treated today?

I've thought about this before, since I like the idea of not totally
ordering operator precedences, but I haven't found an elegant and
light-weight solution to this problem.

-- 
/NAD

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


Re: [Haskell-cafe] Re: StateT and modify

2006-11-08 Thread Nicolas Frisby

Regardless of what monad is transformed by StateT, I think the OP's
issue remains.

modify below is straight from Gill's source at
http://darcs.haskell.org/packages/

modify :: (MonadState s m) = (s - s) - m ()
modify f = do
s - get
put (f s)

we could add

modifyM :: (MonadState s m) = (s - m s) - m ()
modifyM f = do
s - get
s' - f s
  put s'

which I think you could use...

modifyM is just a bit more flexible than Cale's liftModify, I think.

On 11/8/06, Max Vasin [EMAIL PROTECTED] wrote:

 Peter == Peter Steiner [EMAIL PROTECTED] writes:

Peter On 11/8/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:
 Hello Peter,

 Wednesday, November 8, 2006, 1:48:24 PM, you wrote:

  i would like to be able to debug what's happening inside the
 modifier  function. that's why i want to be able to use a
 modifier that's in the  IO monad

 for debugging there is 'trace' function which don't needs IO
 monad

Peter thanks. i am aware of trace, but the potentially messed up
Peter execution order makes it very hard for me to get useful
Peter information out of the resulting trace. besides, IO will
Peter scale to more elaborate logging mechanisms later on...

If all you want from IO is logging why not just use MonadWriter?

--
WBR,
Max Vasin.

___
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] Newbie Q: composeMaybe :: (a - Maybe b) - (b - Maybe c) - (a - Maybe c)

2006-11-08 Thread DeeJay-G615

Hi Dmitri,

your f1 function has 3 arguments, f, g and x.

you pass f as the first argument to mapMaybe, so it naturally must have type (a 
- b).
you pass the result of (g x) to the second argument of mapMaybe, so (g x) must 
have type Maybe a. This means g must have the type (t - Maybe a) where t is the 
type of x.


This gives f1 :: (a - b) - (t - Maybe a) - t - Maybe b

you are going to be passing in something with type (c - Maybe d) as the first 
argument to f1. (I used different type variables to reduce confusion)


This constraint gives f1 the following type

f1 :: (c - Maybe d) - (t - Maybe c) - t - Maybe (Maybe d)

substituting different type variable names gives

f1 :: (b - Maybe c) - (a - Maybe b) - a - Maybe (Maybe c)

So you are very close to finishing... :)
Hope this helps.

DeeJay

Dmitri O.Kondratiev wrote:
I am trying to solve a problem from The Craft of Functional 
Programming book:


14.38 ... define the function:
data Maybe a = Nothing | Just a
composeMaybe :: (a - Maybe b) - (b - Maybe c) - (a - Maybe c)

using functions:

squashMaybe :: Maybe (Maybe a) - Maybe a
squashMaybe (Just (Just x)) = Just x
squashMaybe _ = Nothing

mapMaybe :: (a - b) - Maybe a - Maybe b
mapMaybe f Nothing = Nothing
mapMaybe f (Just x) = Just (f x)

As a first step to the solution I defined auxilary function:
f1 f g x = mapMaybe f (g x)

GHCi gives the following type for this function:

f1 :: (a - b) - (t - Maybe a) - t - Maybe b
 ^^^
Q: I don't quite understand this signature. I would expect this
instead (by mapMaybe definition):
f1 :: (a - b) - (t - Maybe a) - Maybe b


From where does the second 't' come from? What are the arguments and


what f1 returns in this case?
___
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] Re: StateT and modify

2006-11-08 Thread Peter Steiner

cale's solution worked fine for me (i forgot to cc this list in my response).

i have troubles getting your modifyM to compile, and i do not really
understand how it might without somehow lifting the function into the
inner monad.


import Control.Monad.State

type MyState = StateT Int IO

test = evalStateT bar 0

modifyM :: (MonadState s m) = (s - m s) - m ()
modifyM f = do
   s - get
   s' - f s
   put s'

bar :: MyState Int
bar = do
   modifyM $ myAdd 1
   get

myAdd :: Int - Int - IO Int
myAdd x y = do
   putStr in myAdd\n
   return $ x + y


fails with:

   Couldn't match `StateT Int IO' against `IO'
 Expected type: StateT Int IO
 Inferred type: IO
   In a 'do' expression: modifyM $ (myAdd 1)
   In the definition of `bar':
   bar = do
   modifyM $ (myAdd 1)
   get

and applying lift is not possible outside of modifyM.
what am i doing wrong?

regards,
peter.

On 11/8/06, Nicolas Frisby [EMAIL PROTECTED] wrote:

Regardless of what monad is transformed by StateT, I think the OP's
issue remains.

modify below is straight from Gill's source at
http://darcs.haskell.org/packages/

modify :: (MonadState s m) = (s - s) - m ()
modify f = do
s - get
put (f s)

we could add

modifyM :: (MonadState s m) = (s - m s) - m ()
modifyM f = do
s - get
s' - f s
   put s'

which I think you could use...

modifyM is just a bit more flexible than Cale's liftModify, I think.

On 11/8/06, Max Vasin [EMAIL PROTECTED] wrote:
  Peter == Peter Steiner [EMAIL PROTECTED] writes:

 Peter On 11/8/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:
  Hello Peter,
 
  Wednesday, November 8, 2006, 1:48:24 PM, you wrote:
 
   i would like to be able to debug what's happening inside the
  modifier  function. that's why i want to be able to use a
  modifier that's in the  IO monad
 
  for debugging there is 'trace' function which don't needs IO
  monad

 Peter thanks. i am aware of trace, but the potentially messed up
 Peter execution order makes it very hard for me to get useful
 Peter information out of the resulting trace. besides, IO will
 Peter scale to more elaborate logging mechanisms later on...

 If all you want from IO is logging why not just use MonadWriter?

 --
 WBR,
 Max Vasin.

 ___
 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


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


Re: [Haskell-cafe] Re: StateT and modify

2006-11-08 Thread Peter Steiner

On 11/8/06, Max Vasin [EMAIL PROTECTED] wrote:

Peter thanks. i am aware of trace, but the potentially messed up
Peter execution order makes it very hard for me to get useful
Peter information out of the resulting trace. besides, IO will
Peter scale to more elaborate logging mechanisms later on...

If all you want from IO is logging why not just use MonadWriter?


good question. my initial idea, being lazy, was that IO provides
IORefs which might prove useful later on, but then i guess that a
cleanly composed monad will behave better in the long term anyways.

i have to add that this is my first large haskell project and i do
many design decisions on a trial'n'error basis - naturally with a
strong tendency to the error side. ;-)

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


[Haskell-cafe] Re: ANN: System.FilePath 0.10

2006-11-08 Thread Ashley Yakeley

Neil Mitchell wrote:


I am hereby announcing System.FilePath 0.10, which hopefully is pretty
close to final now. This library manipulates FilePath's correctly on
both Posix and Windows.


How do I manipulate a Windows file path on a POSIX machine (something 
relating to Samba, for instance)?


--
Ashley Yakeley

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


Re: [Haskell-cafe] Re: ANN: System.FilePath 0.10

2006-11-08 Thread Neil Mitchell

Hi Ashley,


How do I manipulate a Windows file path on a POSIX machine (something
relating to Samba, for instance)?


import System.FilePath.Windows

This will give you windows FilePath handling regardless of your
operating system.

(in the same way System.FilePath.Posix will give you Linux style
filepaths, and System.FilePath will give you the appropriate type
based on your OS)

Thanks

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


Re: Re: [Haskell-cafe] Re: StateT and modify

2006-11-08 Thread Nicolas Frisby

Applying lift outside of modifyM is not a problem. It can seem a bit
tricky with the function types around. Try


   modifyM $ lift . myAdd 1


instead of


   modifyM $ myAdd 1


Cale's should certainly work fine and lead to more concise code for
what you're after. Just thought I'd mention this in case your needs
change.

Good luck,
Nick

On 11/8/06, Peter Steiner [EMAIL PROTECTED] wrote:

cale's solution worked fine for me (i forgot to cc this list in my response).

i have troubles getting your modifyM to compile, and i do not really
understand how it might without somehow lifting the function into the
inner monad.

 import Control.Monad.State

 type MyState = StateT Int IO

 test = evalStateT bar 0

 modifyM :: (MonadState s m) = (s - m s) - m ()
 modifyM f = do
s - get
s' - f s
put s'

 bar :: MyState Int
 bar = do
modifyM $ myAdd 1
get

 myAdd :: Int - Int - IO Int
 myAdd x y = do
putStr in myAdd\n
return $ x + y

fails with:

Couldn't match `StateT Int IO' against `IO'
  Expected type: StateT Int IO
  Inferred type: IO
In a 'do' expression: modifyM $ (myAdd 1)
In the definition of `bar':
bar = do
modifyM $ (myAdd 1)
get

and applying lift is not possible outside of modifyM.
what am i doing wrong?

regards,
peter.

On 11/8/06, Nicolas Frisby [EMAIL PROTECTED] wrote:
 Regardless of what monad is transformed by StateT, I think the OP's
 issue remains.

 modify below is straight from Gill's source at
 http://darcs.haskell.org/packages/

 modify :: (MonadState s m) = (s - s) - m ()
 modify f = do
 s - get
 put (f s)

 we could add

 modifyM :: (MonadState s m) = (s - m s) - m ()
 modifyM f = do
 s - get
 s' - f s
put s'

 which I think you could use...

 modifyM is just a bit more flexible than Cale's liftModify, I think.

 On 11/8/06, Max Vasin [EMAIL PROTECTED] wrote:
   Peter == Peter Steiner [EMAIL PROTECTED] writes:
 
  Peter On 11/8/06, Bulat Ziganshin [EMAIL PROTECTED] wrote:
   Hello Peter,
  
   Wednesday, November 8, 2006, 1:48:24 PM, you wrote:
  
i would like to be able to debug what's happening inside the
   modifier  function. that's why i want to be able to use a
   modifier that's in the  IO monad
  
   for debugging there is 'trace' function which don't needs IO
   monad
 
  Peter thanks. i am aware of trace, but the potentially messed up
  Peter execution order makes it very hard for me to get useful
  Peter information out of the resulting trace. besides, IO will
  Peter scale to more elaborate logging mechanisms later on...
 
  If all you want from IO is logging why not just use MonadWriter?
 
  --
  WBR,
  Max Vasin.
 
  ___
  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

___
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


[Haskell-cafe] Re: Re: aggressiveness of functional dependencies

2006-11-08 Thread Nicolas Frisby

Last post until a response I promise! Another demonstration:

bar () = runIdentity . flip runStateT 0 $ return 'c'

Inferred signature:
  bar :: (Monad (StateT s Identity), Num s) = () - (Char, s)

Why not?
  bar :: Num s = () - (Char, s)

I am not coming up with an s that could prevent (StateT s Identity)
from being a monad. Is there one?

Nick

On 11/7/06, Nicolas Frisby [EMAIL PROTECTED] wrote:

Having thought longer about it, it seems to be an issue with
functional dependencies and overlapping instances.

Perhaps, because an overlapping instance may be defined in some other
module which would trump the Iso instance for Either, the type
inference mechanism cannot commit to the instance presented in my
code. It's being conservative.

My confusion stems from the notion of functional dependency. Given the
functional dependencies of Iso, there is exactly one type b for any
type a such that Iso a b (and also vice versa). Thus it would seem
that c for Iso (Either a b) c is always uniquely determined because of
the instance from my code.

However, because a more specific overlapping instance could always be
added, this isn't the case. That more specific instances could specify
something like Iso (Either Char Char) (Either Int Int). The functional
dependency check does not recognize that this violates the
dependencies introduced by the more general instance's context. I
think this is because said dependencies (the inductives: Iso f f' and
Iso g g') are introduced iff the more general instance fires.

Is the type inference conservative because the possibility of a new
overlapping instance always looms? If so, is this a good thing or a
bad thing? Is this the murky water that Strongly Typed Heterogeneous
Collections mentions?

Sorry to double post. Thanks again,
Nick



On 11/6/06, Nicolas Frisby [EMAIL PROTECTED] wrote:
 I have a question about functional dependencies, instance contexts,
 and type inference. A specific example and question is in the attached
 code.

 In brief the question is: to what degree does type inference use the
 functional dependencies of an instance's class and context? I believe
 I am wishing it were more aggressive than it is. Please note that I
 have not enabled overlapping instances.

 Any suggestions regarding how to get the inferred type of |rite_t1| to
 be the one I anticipated would be much appreciated. Of course, I would
 also appreciate explanations of why I shouldn't anticipate it!

 The rest of this message is a copy of the attached code.

 Thanks,
 Nick



 I'm using GHC 6.6, but I see the same inferred types with 6.4.1.

  {-# OPTIONS -fglasgow-exts #-}
  {-# OPTIONS -fallow-undecidable-instances #-} -- for the coverage condition
 
  module FunDepEx where


 A plain ole' isomorphism class.

  class Iso a b | a - b, b - a where
  rite :: a - b
  left :: b - a


 Isomorphism lifts through the sum bifunctor.

  bifmap_either f g = either (Left . f) (Right . g)
 
  instance ( Iso f f', Iso g g'
   ) = Iso (Either f g) (Either f' g') where
  rite = bifmap_either rite rite
  left = bifmap_either left left


 Some types to play around with.

  newtype MyChar = MyChar Char deriving (Show, Eq)
 
  instance Iso MyChar Char where
  rite (MyChar c) = c
  left c = MyChar c
  instance Iso Char MyChar where
  rite c = MyChar c
  left (MyChar c) = c


 My type inference confusion follows; the unit arguments are just to
 suppress the monomorphism restriction.

  t1 :: Either Char a
  t1 = Left 'c'
 
  rite_t1 () = rite t1

 The inferred type for rite_t1 is
 rite_t1 :: (Iso (Either Char a) (Either f' g')) = () - Either f' g'

 Why isn't the inferred type of rite_t1 the same as the ascribed type
 of rite_t1'?

  rite_t1' :: Iso b b' = () - Either MyChar b'
  rite_t1' () = rite t1





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


Re: [Haskell-cafe] How to design default implementations of type class methods?

2006-11-08 Thread ajb
G'day all.

Quoting Henning Thielemann [EMAIL PROTECTED]:

 I like to hear some opinions about how to implement class method defaults.

In this case, don't.  Use instance defaults instead.

class (Eq a) = Ring a where
(*),(+),(-) :: a - Integer
zero, one :: a

negate :: a - a
negate = (zero -)

isZero :: a - Bool
isZero = (==zero)


class (Ring a) = RingWithNorm a where
nu :: a - Integer

class (RingWithNorm a) = EuclideanDomain a where
divMod :: a - a - (a,a)

class (RingWithNorm a) = GCD a where
gcd :: a - a - a

instance (EuclideanDomain a) = GCD a where
gcd = {- Euclidean GCD algorithm; detail omitted -}

Then if you have some other domain where GCD applies, you can create
other instances as needed:

class (RingWithNorm a) = SteinDomain a where
smallestPrime :: a
steinDecompose :: a - Maybe (a,a)

-- scale p q = p/q
-- where nu q  nu smallestPrime
scale :: a - a - a

instance (SteinDomain a) = GCD a where
gcd a b
  | nu a  nu b = gcd b a
  | a == b = a
  | otherwise = case (steinDecompose a, steinDecompose b) of
  (Nothing,_) - b
  (_,Nothing) - a
  (Just (pa,ca), Just (pb,cb))
| isZero ca  isZero cb - smallestPrime * gcd pa pb
| isZero cb - gcd a pb
| otherwise - gcd (pa - scale (ca*pb) cb) b

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


[Haskell-cafe] don't: a 'do' for comonads?

2006-11-08 Thread Donald Bruce Stewart
As seen on #haskell, from an idea by Malcolm,

14:42  ?let top'n'tail = (pre++) . (++/pre) 
14:42  lambdabot Defined.
14:43  dons  L.top'n'tail foo me now
14:43  lambdabot  prefoo me now/pre
14:43  mauke that reminds me, haskell needs don't
14:43  dons yes!
14:44  pkhuong- mm. the opposite of do, eh? do for comonads? :)

So now a prize to the person who comes up with the best use for the
identifier:

don't :: ?

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


[Haskell-cafe] Sistema de Ecuaciones NO lineales

2006-11-08 Thread Sebastian Gaviria
hola como estan

Quiero preguntar quien puede resolver el sistemas de ecuaciones NO lineales de Newton y el codigo de Jacobi en Haskell

me ayudarian mucho al poder implementar ese codigo

por Favor es con urgencia tener estos codigos!!


muchas gracias !!!-- La sociedad debe juzgarse por su capacidad para hacer que la gente sea feliz.SEBASTIAN GAVIRIA J.INGENIERIA SISTEMAS UNIVERSIDAD EAFIT
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe