[Haskell-cafe] which tags program should I use?

2011-09-25 Thread Henry Laxen
Dear Group,

I have a simple question, that as far as I can tell, has never really
been well answered.  I would like to generate TAGS files for haskell
source.  Reading the http://www.haskell.org/haskellwiki/Tags page
suggests using :etags in GHCI or hasktags, or gasbag.  Of the three,
hasktags comes closest to working but it has (for me) a major
inconvenience, namely it finds both function definitions and type
signatures, resulting in two TAGS entries such as:

./Main.hs,63
module Main where6,7
main ::24,25
main =25,26

Now when I do an emacs find-tag (I use icicles) I will always have to
choose which tag I want to visit, and the completion buffer contains
something like:

main ::
hs/Main.hs

main =
hs/Main.hs


Granted, this is a minor (and very specialized) complaint, but if
hasktags were to select only ONE of either the type signature (my
first choice) or the function definition, (if no type signature) this
annoyance would disappear.  

I also tried using etags, which I think would work, but it seems to
have one killer bug (feature), namely that it dies if it finds an
uninterpreted import:

  when (not is_interpreted) $
let mName = GHC.moduleNameString (GHC.moduleName m) in
ghcError (CmdLineError (module ' ++ mName ++ ' is not interpreted))

I think it would work much better if it just warned you, instead of
dying.  This makes it unusable any time you import something
precompiled.

Now some looking at the README of hasktags leads me to:

In the past this tool was distributed with ghc. I forked and added some
features.  hasktags itself was moved out of the ghc repository. Then I only
verified that my fork finds at least as much tags as the one forked by
Igloo.

That makes me feel a little queasy.

A google search for hasktags igloo turns up
http://hackage.haskell.org/trac/ghc/ticket/1508 
whose title is hasktags program needs replacement
which makes me feel even more queasy.

So I guess my question is, what are us disciples of the one true
editor to do?  Thanks in advance for you sage advice.

Best wishes,
Henry Laxen




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


[Haskell-cafe] SPECIALIZE in the presence of constraints

2011-09-25 Thread Nicu Ionita

Hallo List,

I can't understand how pragma SPECIALIZE works in the presence of 
constraints.


I have 2 modules, one which defines a general search framework, and one 
which implements it in a concrete context. The general module defines 
functions like:


{-# SPECIALIZE pvQSearch :: Node (Game m) Move Int = Int - Int - Int 
- Search (Game m) Move Int Int #-}

pvQSearch :: Node m e s = s - s - Int - Search m e s s
pvQSearch a b c = do ...

while the implementation uses concrete data types Move and Int (for e 
and s respectively) and defines instances and other types (like the 
polimorphic type Game m, where m is a monad).


Node m e s is a class and the instance Node (Game m) Move Int is defined 
in the implementation module. From outside this construct is used by 
calling a generic search function, but giving parameters which match the 
implementation (i.e. with Move and Int for e and s, for example).


Now what I don't understand:

1. how can the compiler (here ghc) know which function to expose as the 
correct generic search function? There must be two search functions 
generated, one generic and its specialization. Does the module export 
both and later the linker chooses the correct one, when the client 
module is known?


2. how can I know that the specialization is really used? When I have 
constraints, will the specializations be generated in the assumption 
that the constraint is matched? When will be this match checked?


My problem is that, with or without specializations, the performance of 
the code is the same - so I doubt the specializations are used.


Thanks,

Nicu

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


Re: [Haskell-cafe] instance Enum Double considered not entirely great?

2011-09-25 Thread Chris Smith
Would it be an accurate summary of this thread that people are asking
for (not including quibbles about naming and a few types):

class Ord a = Enum a where
succ :: a - a
pred :: a - a
fromEnum :: a - Int(eger)
toEnum :: Int(eger) - a
-- No instance for Float/Double

class Ord a = Range a where
rangeFromTo :: a - a - [a] -- subsumes Ix.range / Enum.enumFromTo
rangeFromThenTo :: a - a - a - [a]
inRange   :: (a, a) - a - Bool
-- Does have instances for Float/Double.  List ranges desugar to this.
-- Also has instances for tuples

class Range a = InfiniteRange a where -- [1]
rangeFrom :: a - [a]
rangeFromThen :: a - a - [a]
-- Has instances for Float/Double
-- No instances for tuples

class Range a = Ix a where
index :: (a, a) - a - Int
rangeSize :: (a, a) - Int

-- Again no instances for Float/Double.  Having an instance here implies
-- that the rangeFrom* are complete, containing all 'inRange' values

class (RealFrac a, Floating a) = RealFloat a where
... -- existing stuff
(..), (.=.), (..), (.=.), (.==.) :: a - a - Bool
-- these are IEEE semantics when applicable

instance Ord Float where ... -- real Ord instance where NaN has a place

There would be the obvious properties stated for types that are
instances of both Enum and Range, but this allows for non-Enum types to
still be Range instances.

If there's general agreement on this, then we at least have a proposal,
and one that doesn't massively complicate the existing system.  The next
step, I suppose would be to implement it in an AltPrelude module and
(sadly, since Enum is changing meaning) a trivial GHC language
extension.  Then the real hard work of convincing more people to use it
would start.  If that succeeds, the next hard work would be finding a
compatible way to make the transition...

I'm not happy with InfiniteRange, but I imagine the alternative (runtime
errors) won't be popular in the present crowd.

-- 
Chris



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


Re: [Haskell-cafe] SPECIALIZE in the presence of constraints

2011-09-25 Thread Max Bolingbroke
On 26 September 2011 01:37, Nicu Ionita nicu.ion...@acons.at wrote:
 1. how can the compiler (here ghc) know which function to expose as the
 correct generic search function? There must be two search functions
 generated, one generic and its specialization.

Yes, exactly. If you have:

{-# SPECIALISE f :: Int - Int #-}
f :: Num a = a - a
f = ...

Then GHC basically generates:

f_spec :: Int - Int
f_spec = f

f :: Num a = a - a
f = ...

{-# RULES f_spec f = f_spec #-}

 Does the module export both
 and later the linker chooses the correct one, when the client module is
 known?

The RULES mechanism chooses the correct one: when f applied to the
specialised type arguments is seen, the generated RULE rewrites it to
f_spec.

 2. how can I know that the specialization is really used? When I have
 constraints, will the specializations be generated in the assumption that
 the constraint is matched? When will be this match checked?

The specialisation will be used if GHC can see that the generic
function is applied to the correct type arguments. So for example a
call to f inside another polymorphic function g (say g contains a use
of f like: g = ... (f :: Int - Int) ...) won't get specialised unless
g it itself specialised or inlined.

 My problem is that, with or without specializations, the performance of the
 code is the same - so I doubt the specializations are used.

GHC tells you which RULEs fired if you use -ddump-simpl or ghc-core.
That might help you diagnose it, since if you see a rule fired for the
specialisation then your code is probably using it. Failing that,
inspecting the core output itself is always useful.

Max

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


Re: [Haskell-cafe] instance Enum Double considered not entirely great?

2011-09-25 Thread Daniel Fischer
On Sunday 25 September 2011, 19:20:52, Chris Smith wrote:
 Would it be an accurate summary of this thread that people are asking
 for (not including quibbles about naming and a few types):

Not quite, I'm afraid.

 
 class Ord a = Enum a where
 succ :: a - a
 pred :: a - a
 fromEnum :: a - Int(eger)
 toEnum :: Int(eger) - a
 -- No instance for Float/Double

I'm not in favour of introducing an Ord constraint here.
For

data WeekDay
= Sunday
...

data Month
= January
...

an Ord instance would be dubious, but Enum is plenty fine.

 
 class Ord a = Range a where
 rangeFromTo :: a - a - [a] -- subsumes Ix.range / Enum.enumFromTo
 rangeFromThenTo :: a - a - a - [a]
 inRange   :: (a, a) - a - Bool
 -- Does have instances for Float/Double.  List ranges desugar to this.
 -- Also has instances for tuples

Don't mix range and arithmetic sequences. I want arithmetic sequences for 
Double, Float and Rational, but not range.
(For Float and Double one could implement range [all values between the 
given bounds, in increasing order, would be the desired/expected semantics 
for that, I think?], but I'm rather sure that's not what one does normally 
want, and for Rational, you can't even implement it.)

Also, I doubt whether rangeFromThenTo is a useful addition to range, I 
don't see how it would be natural for tuples. (The Ix instance for tuples 
doesn't use the lexicographic ordering, but the box-partial order - 
presumably so would the Range instance, so the 'distance' between two 
tuples would depend on the given bounds. Using the box-partial order is 
fine for range, but seems weird for blahFromThenTo.)

 
 class Range a = InfiniteRange a where -- [1]
 rangeFrom :: a - [a]
 rangeFromThen :: a - a - [a]
 -- Has instances for Float/Double
 -- No instances for tuples
 
 class Range a = Ix a where
 index :: (a, a) - a - Int
 rangeSize :: (a, a) - Int
 
 -- Again no instances for Float/Double.  Having an instance here implies
 -- that the rangeFrom* are complete, containing all 'inRange' values

Ho Hum. So Range would continue the same ambiguity/confusion that started 
this thread, albeit in mitigated form.

Separating range from arithmetic (or 'fixed-step-size') sequences is 
cleaner (we'd lose default methods anyway, you need Enum or Num  Ord for 
them, but we now have numericEnumFrom* to make Enum instances for Num types 
easier, we could move the current default methods out of the class to have 
enumEnumFrom* so that writing instances for Enum types would be easier).

 
 class (RealFrac a, Floating a) = RealFloat a where
 ... -- existing stuff
 (..), (.=.), (..), (.=.), (.==.) :: a - a - Bool
 -- these are IEEE semantics when applicable
 
 instance Ord Float where ... -- real Ord instance where NaN has a place

Yes. I have pondered leaving Eq and Ord for Double and Float as is and 
providing a newtype wrapper with container/sort-safe instances, but that'd 
be cumbersome, people wouldn't know they exist and (when) they have to use 
them, urk.
Also, although it's a change in behaviour, it doesn't badly break backwards 
compatibility., as far as I can see (I hope x /= x isn't heavily used as a 
NaN test).
So yes, definitely yes.

 
 There would be the obvious properties stated for types that are
 instances of both Enum and Range, but this allows for non-Enum types to
 still be Range instances.
 
 If there's general agreement on this, then we at least have a proposal,
 and one that doesn't massively complicate the existing system.  The next
 step, I suppose would be to implement it in an AltPrelude module and
 (sadly, since Enum is changing meaning) a trivial GHC language
 extension.  Then the real hard work of convincing more people to use it
 would start.  If that succeeds, the next hard work would be finding a
 compatible way to make the transition...
 
 I'm not happy with InfiniteRange, but I imagine the alternative (runtime
 errors) won't be popular in the present crowd.


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


Re: [Haskell-cafe] instance Enum Double considered not entirely great?

2011-09-25 Thread Chris Smith
 Don't mix range and arithmetic sequences. I want arithmetic sequences for 
 Double, Float and Rational, but not range.
 (For Float and Double one could implement range [all values between the 
 given bounds, in increasing order, would be the desired/expected semantics 
 for that, I think?],

Okay, fine, I tried.  Obviously, I'm opposed to just flat removing
features from the language, especially when they are so useful that they
are being used without any difficulty at all by the 12 year olds I'm
teaching right now.

Someone (sorry, not me) should really write up the proposed change to
Ord for Float/Double and shepherd them through the haskell-prime
process.  That one shouldn't even be controversial; there's already an
isNaN people should be using for NaN checks, and any code relying on the
current behavior is for all intents and purposes broken anyway.  The
only question is whether to add the new methods to RealFloat (breaking
on the bizarre off chance that someone has written a nonstandard
RealFloat instance), or add a new IEEE type class.

-- 
Chris Smith



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


Re: [Haskell-cafe] instance Enum Double considered not entirely great?

2011-09-25 Thread Daniel Fischer
On Sunday 25 September 2011, 23:13:47, Chris Smith wrote:
  Don't mix range and arithmetic sequences. I want arithmetic sequences
  for Double, Float and Rational, but not range.
  (For Float and Double one could implement range [all values between
  the given bounds, in increasing order, would be the desired/expected
  semantics for that, I think?],
 
 Okay, fine, I tried.  Obviously, I'm opposed to just flat removing
 features from the language, especially when they are so useful that they
 are being used without any difficulty at all by the 12 year olds I'm
 teaching right now.

Agreed. But If we want a change to remove a wart, we should try to remove 
it completely. We can still settle for make it smaller if it doesn't work 
out.

 
 Someone (sorry, not me) should really write up the proposed change to
 Ord for Float/Double

Okay.

 and shepherd them through the haskell-prime process.

Uh oh. I ope that can be done with a libraries proposal.
(Ian says yes :-D)

 That one shouldn't even be controversial; there's already an
 isNaN people should be using for NaN checks, and any code relying on the
 current behavior is for all intents and purposes broken anyway.  The
 only question is whether to add the new methods to RealFloat (breaking
 on the bizarre off chance that someone has written a nonstandard
 RealFloat instance), or add a new IEEE type class.

Add to RealFloat, default to the Eq/Ord functions, I'd say.

But that's not the only question. Is -0.0 == 0.0 or not?
I lean towards no because of 1/x, but I'm not wedded to that.

And: distinguish NaNs or identify them all?
I lean towards identifying them all, I've never cared for whether they come 
from 0/0, Infinity - Infinity or what, but I could be convinced.

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


[Haskell-cafe] CFG specification and analysis directly in Haskell

2011-09-25 Thread Anton Tayanovskyy
Hi,

As a weekend hack, I just realized that Haskell has this wonderful
DoRec syntax that among other things seems to be able to let the user
express context-free grammars together with their processing rules in
normal Haskell code, without template Haskell or anything like that,
just like parser combinators.

I am just wondering if this is this a known and useful result? Are
there libraries doing similar stuff?

I wrote up the Earley algorithm to demonstrate that one can in
principle analyze the complete grammar
(https://github.com/toyvo/haskell-earley). The result derivations
`cheat` by using Data.Dynamic, but the result is quite pleasing, for
example one can do:

grammar :: G.Grammar (G.Rule Char E)
grammar = do
  nat - G.rule NAT
 [ fmap (\_ - 0) (G.term '0')
 , fmap (\_ - 1) (G.term '1')
 ]
  rec expr - G.rule EXPR
  [ fmap Nat $ G.var nat
  , pure (\x _ y - Add x y)
* G.var expr
* G.term '+'
* G.var expr
  ]
  return expr

Thanks,

Anton

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


[Haskell-cafe] ANN: flexiwrap-0.1.0 etc.

2011-09-25 Thread Iain Alexander
New versions of the package flexiwrap (supplying flexible wrappers for instance 
selection) and related packages have been released to Hackage.

flexiwrap-0.1.0
data-type-0.1.0
function-combine-0.1.0
flexiwrap-smallcheck-0.0.1

flexiwrap version 0.1.0 supports instances of many additional classes for 
FlexiWrap, and improved documentation, although much remains to be done - more 
class instances for FlexiWrap, and other wrappers, and more documentation.

data-type version 0.1.0 adds a proxy type Data.Type.Proxy.

function-combine version 0.1.0 updates its dependencies to support the new 
version of data-type.

flexiwrap-smallcheck version 0.1.0 is a new package supplying support for 
instances of Serial for FlexiWrap, for use with the smallcheck package.  
Support for Serial instances for other wrappers is outstanding.

Regards,

Iain.
-- 
i...@stryx.demon.co.uk


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