Re: [Haskell-cafe] Still having problems building a very simple Executable ....

2009-06-07 Thread Vasili I. Galchin
thanks, David.

Vasili

On Sun, Jun 7, 2009 at 12:17 AM, David Menendez d...@zednenem.com wrote:

 On Sat, Jun 6, 2009 at 11:54 PM, Vasili I. Galchin vigalc...@gmail.com
 wrote:
  Hi David,
 
   I commented out Hs-source-dirs
 
  Executable QNameTest
  --   Hs-source-dirs: Swish/
 Main-Is:HaskellUtils/QNameTest.hs

 Swish/HaskellUtils/QNameTest.hs

 Other-Modules:  HaskellUtils.QName

 Swish.HaskellUtils.QName

 --
 Dave Menendez d...@zednenem.com
 http://www.eyrie.org/~zednenem/ http://www.eyrie.org/%7Ezednenem/

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


[Haskell-cafe] Re: Haddock : parse error on input `{-# UNPACK'

2009-06-07 Thread Dominic Steinitz
Erik de Castro Lopo mle+hs at mega-nerd.com writes:

 
 Dominic Steinitz wrote:
 
  Erik de Castro Lopo mle+hs at mega-nerd.com writes:
  
   
 src/Data/Binary/Strict/IncrementalGet.hs:106:11:
 parse error on input `{-# UNPACK'
   
  
  This is a haddock error and I presume a bug in haddock.
 
 Well I raised a bug here:
 
 http://trac.haskell.org/haddock/ticket/109
 
 Thats actually not the problem. I'm trying to build a debian package
 for this thing and this haddock problem is preventing that.
 
 Erik

This seems to be the problem:
http://hackage.haskell.org/trac/hackage/ticket/230. There's obviously a work
round for it as the haddock for the binary package builds (e.g.
http://hackage.haskell.org/packages/archive/binary/0.5.0.1/doc/html/Data-Binary-Get.html)
but I don't know what it is.

What's even more frustrating is one of the authors of has tried:

#ifndef __HADDOCK__
-- | The parse state
data S = S {-# UNPACK #-} !BL.ByteString  -- ^ input
   {-# UNPACK #-} !Int  -- ^ bytes read
   {-# UNPACK #-} ![B.ByteString]
   {-# UNPACK #-} !Int  -- ^ the failure depth
#endif

and haddock ignores this. And the binary package just has this (no ifdefs!):

-- Our internal buffer type
data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8)
 {-# UNPACK #-} !Int-- offset
 {-# UNPACK #-} !Int-- used bytes
 {-# UNPACK #-} !Int-- length left

Perhaps one of the authors of binary can tell us their secret of success?

Dominic.



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


[Haskell-cafe] Re: Haddock : parse error on input `{-# UNPACK'

2009-06-07 Thread Dominic Steinitz
Dominic Steinitz dominic at steinitz.org writes:

 
 Erik de Castro Lopo mle+hs at mega-nerd.com writes:
 
  
  Dominic Steinitz wrote:
  
   Erik de Castro Lopo mle+hs at mega-nerd.com writes:
   

  src/Data/Binary/Strict/IncrementalGet.hs:106:11:
  parse error on input `{-# UNPACK'

   
   This is a haddock error and I presume a bug in haddock.
  
  Well I raised a bug here:
  
  http://trac.haskell.org/haddock/ticket/109
  

Ha! It's yet another of haddock's quirks. If I replace -- ^ by -- then haddock
accepts {-#. I'll update the ticket you created.

-- | The parse state
data S = S {-# UNPACK #-} !BL.ByteString  -- ^ input
   {-# UNPACK #-} !Int  -- ^ bytes read
   {-# UNPACK #-} ![B.ByteString]
   {-# UNPACK #-} !Int  -- ^ the failure depth

-- | The parse state
data S = S {-# UNPACK #-} !BL.ByteString  -- input
   {-# UNPACK #-} !Int  -- bytes read
   {-# UNPACK #-} ![B.ByteString]
   {-# UNPACK #-} !Int  -- the failure depth

Dominic.

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


[Haskell-cafe] totally confused about Haskell namespace issue conventions

2009-06-07 Thread Vasili I. Galchin
Hello,

  Should namespace designation be specified in modules or in the .cabal
file? Or to put it another way should a relative namespace be specified in a
Haskell module and the remaining top part be specified in the associated
.cabal file? Of course, yes/no answers are probably not sufficient ... i.e.
please elaborate.

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


[Haskell-cafe] Re: totally confused about Haskell namespace issue conventions

2009-06-07 Thread Vasili I. Galchin
let put this subject in another way ... assuming there a coding convention,
vis-a-vis Haskell namespace, what is the division of responsibility between
a Haskell module and it's associated .cabal?

Regards,

Vasili

On Sun, Jun 7, 2009 at 2:26 AM, Vasili I. Galchin vigalc...@gmail.comwrote:

 Hello,

   Should namespace designation be specified in modules or in the .cabal
 file? Or to put it another way should a relative namespace be specified in a
 Haskell module and the remaining top part be specified in the associated
 .cabal file? Of course, yes/no answers are probably not sufficient ... i.e.
 please elaborate.

 Kind regards, Vasili

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


Re: [Haskell-cafe] Re: Haddock : parse error on input `{-# UNPACK'

2009-06-07 Thread Erik de Castro Lopo
Dominic Steinitz wrote:

 -- | The parse state
 data S = S {-# UNPACK #-} !BL.ByteString  -- ^ input
{-# UNPACK #-} !Int  -- ^ bytes read
{-# UNPACK #-} ![B.ByteString]
{-# UNPACK #-} !Int  -- ^ the failure depth
 
 -- | The parse state
 data S = S {-# UNPACK #-} !BL.ByteString  -- input
{-# UNPACK #-} !Int  -- bytes read
{-# UNPACK #-} ![B.ByteString]
{-# UNPACK #-} !Int  -- the failure depth
 
Thanks Dominic. Thats a workaround I can use.

Cheers,
Erik
-- 
--
Erik de Castro Lopo
http://www.mega-nerd.com/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: totally confused about Haskell namespace issue conventions

2009-06-07 Thread Vasili I. Galchin
let me state another way 

as far as namespace is concerned what is division between a module's name
and it's associated .cabal with it's Hs-Source-Dirs directive? This is
kinda' absolute vs relative path I think.

Regards,

Vasili

On Sun, Jun 7, 2009 at 2:46 AM, Vasili I. Galchin vigalc...@gmail.comwrote:

 let put this subject in another way ... assuming there a coding convention,
 vis-a-vis Haskell namespace, what is the division of responsibility between
 a Haskell module and it's associated .cabal?

 Regards,

 Vasili

 On Sun, Jun 7, 2009 at 2:26 AM, Vasili I. Galchin vigalc...@gmail.comwrote:

 Hello,

   Should namespace designation be specified in modules or in the
 .cabal file? Or to put it another way should a relative namespace be
 specified in a Haskell module and the remaining top part be specified in
 the associated .cabal file? Of course, yes/no answers are probably not
 sufficient ... i.e. please elaborate.

 Kind regards, Vasili



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


Re: [Haskell-cafe] Question on rank-N polymorphism

2009-06-07 Thread Vladimir Reshetnikov
Hi Zsolt,

fs :: (((a, a) - a) - t) - (t, t)
fs g = (g fst, g snd)
examples = (fs fmap, fs liftA, fs liftM, fs id, fs ($(1,2)), fs
((,)id), fs (:[]), fs repeat)

No instance for (Num [Char])
  arising from the literal `1' at M.hs:6:54
Possible fix: add an instance declaration for (Num [Char])
In the expression: 1
In the second argument of `($)', namely `(1, 2)'
In the first argument of `fs', namely `($ (1, 2))'

Anyways, this signature is not what intended. I want it to work for
all tuples, regardless of their element types.

Thanks
Vladimir

On 6/7/09, Zsolt Dollenstein zsol.z...@gmail.com wrote:
 On Sun, Jun 7, 2009 at 9:17 AM, Vladimir
 Reshetnikovv.reshetni...@gmail.com wrote:
 Hi Zsolt,

 It does not compiles with GHC without type annotations.

 It does with mine: The Glorious Glasgow Haskell Compilation System, version
 6.10.2

 Anyway, try this: fs :: (((a, a) - a) - t) - (t, t)


 Thanks,
 Vladimir

 On 6/7/09, Zsolt Dollenstein zsol.z...@gmail.com wrote:
 Hi Vladimir,

 On Sun, Jun 7, 2009 at 12:06 AM, Vladimir
 Reshetnikovv.reshetni...@gmail.com wrote:
 Hi,

 I have the following code:

 
 fs g = (g fst, g snd)
 examples = (fs fmap, fs liftA, fs liftM, fs id, fs ($(1,2)), fs
 ((,)id), fs (:[]), fs repeat)
 

 The idea is that fs accepts a polymorphic function as its argument.
 What type signature can I specify for f in order to compile this code?

 Have you tried putting the above into ghci for example, then asking for
 :t
 fs?
 Or am I misunderstanding your point?

 Cheers,
 Zsolt

 If it is not possible in Haskell, is there another language with
 static typing which allows this?

 Thanks,
 Vladimir
 ___
 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] Question on rank-N polymorphism

2009-06-07 Thread Ryan Ingram
This is a really interesting question.

So, fs is well-typed in Haskell:
   fs :: (((a,a) - a) - t) - (t,t)
i.e.
   fs id :: ((a,a) - a, (a,a) - a)

However, I believe what you are asking is for fs to be equivalent to
the following:
 fs2 f g = (f fst, g snd)

which has the type
fs2 :: (((a, b) - a) - t) - (((a1, b1) - b1) - t1) - (t, t1)

except with the argument broadcast polymorphically to both positions.

This means the argument must have the multitype

g :: ((a,b) - a) - t  /\  ((a1,b1) - b1) - t1

for some t and t1 which are functions of a,b and a1,b1.

Unfortunately I don't believe it is possible to encode this type in
System F or System F(c), the underlying lambda-calculus used by GHC,
so Haskell isn't going to be able to solve this problem.  But there
are statically typed languages which can solve this problem.

You can take the big hammer of dependent types, and write fs something
like this (not Haskell; this is a dependently-typed language):

typeof_g :: (Type - Type - Type - Type) - Type
typeof_g res_type = (a :: Type) - (b :: Type) - (c :: Type) -
((a,b) - c) - res_type a b c

fs :: (res_type :: Type - Type - Type - Type) - (g :: typeof_g res_type)
  - (a :: Type) - (b :: Type) - (res_type a b a, res_type a b b)
fs _ g a b = (g a b a fst, g a b b snd)

So, you'd write fs id like this:
 fs (\a b c. (a,b) - c) (\a b c. id ((a,b) - c))

This is a fascinating problem, though.  What put you on this path?

  -- ryan

On Sat, Jun 6, 2009 at 3:06 PM, Vladimir
Reshetnikovv.reshetni...@gmail.com wrote:
 Hi,

 I have the following code:

 
 fs g = (g fst, g snd)
 examples = (fs fmap, fs liftA, fs liftM, fs id, fs ($(1,2)), fs
 ((,)id), fs (:[]), fs repeat)
 

 The idea is that fs accepts a polymorphic function as its argument.
 What type signature can I specify for f in order to compile this code?
 If it is not possible in Haskell, is there another language with
 static typing which allows this?

 Thanks,
 Vladimir
 ___
 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] totally confused about Haskell namespace issue conventions

2009-06-07 Thread Magnus Therning

Vasili I. Galchin wrote:

Hello,
 
  Should namespace designation be specified in modules or in the 
.cabal file? Or to put it another way should a relative namespace be 
specified in a Haskell module and the remaining top part be specified 
in the associated .cabal file? Of course, yes/no answers are probably 
not sufficient ... i.e. please elaborate.


This is my, probably incomplete, understanding of how things work.

The module statement at the top of a Haskell source file should contain the 
complete name, e.g.


module Foo.Bar.Baz

If you use GHC directly to build (e.g. using --make) then it will look for the 
module above at $x/Foo/Bar/Baz.hs, where $x is on of the paths where GHC has 
been told to look (e.g. using -i).


In a Cabal file you mention the complete names of module you use/build (e.g. 
Foo.Bar.Baz above).  Hs-Source-Dirs adds directories to the paths where GHC 
looks for modules ($x above).


/M

--
Magnus Therning(OpenPGP: 0xAB4DFBA4)
magnus@therning.org  Jabber: magnus@therning.org
http://therning.org/magnus identi.ca|twitter: magthe



signature.asc
Description: OpenPGP digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Roman to Decimal Algorithms

2009-06-07 Thread Andrew Savige

I recently played in a code golf Roman to Decimal challenge (in Perl,
Python, Ruby and PHP). In playing this game, I found some interesting
short algorithms for converting from Roman Numerals to Decimal. Because
I think some of these are new, I'd like to present them here, in case
they are not really new after all, or in case there are problems with
these algorithms that I've overlooked.

I'd like to eventually write up a rosetta code article comparing the
implementation of these algorithms in various languages, including
Haskell. Since I'm only a very occasional Haskell programmer, I thought
it best to get feedback from Haskell experts before inflicting any of
my Haskell code on a wider audience. Hence this post.

To keep this post reasonably brief, note that these algorithms are for
modern Roman Numerals only, limited to the range 1-3999, and with no
error checking. That is, the code below assumes that the input is always
a well formed Roman Numeral. I have tested each algorithm against every
modern Roman Numeral in the range 1-3999.

As a starting point, note this HaskellWiki function:

romanToInt :: String - Int
romanToInt = fst
  . foldr (\p (t,s) - if p = s then (t+p,p) else (t-p,p)) (0,0)
  . map (fromJust . flip lookup (zip IVXLCDM 
[1,5,10,50,100,500,1000]))

taken from http://haskell.cs.yale.edu/haskellwiki/Roman_numerals.
I'm going to essentially duplicate the functionality of this code.

{-# OPTIONS_GHC -fglasgow-exts -Wall #-}
import Data.Char (toUpper)

rtoa :: Char - Int
rtoa 'M' = 1000
rtoa 'D' =  500
rtoa 'C' =  100
rtoa 'L' =   50
rtoa 'X' =   10
rtoa 'V' =    5
rtoa 'I' =    1
rtoa r   = error $ Invalid rtoa char: ++ show r

urtoa :: Char - Int
urtoa = rtoa . toUpper

romanToInt :: String - Int
romanToInt = foldl1 (\t n - t+n-t`mod`n*2) . map urtoa

The essential difference between this solution and the HaskellWiki
one is the use of the running total for state rather than the
previous value. I see this as an improvement mainly because it
is shorter -- though you might argue that it is less clear.

An alternative way to express the romanToInt function is:

romanToInt = foldl (\t c - t+(urtoa c)-t`mod`(urtoa c)*2) 0

I'm open to persuasion as to which is better Haskell style.

Since I'm not playing golf anymore, the rtoa function above, though
hardly short, seemed to me to be the simplest and clearest way to
express converting a single Roman Numeral to its corresponding
arabic number. Again, suggestions for the best/most efficient
way to do this in Haskell are most welcome.

A common, and often winning technique, in golf is to perform these
sorts of conversions by concocting a magic formula. For fun, I
rewrote rtoa using a magic formula I used in the golf game:

rtoa c = 10^(205558`mod`(ord c)`mod`7)`mod`9995

I'm not suggesting that magic formulae are useful outside of golf and
this second rtoa function, though shorter, is much less clear. I might
add that this particular magic formula appears to be less useful in
Haskell golf than the other languages because `mod` is five times
longer than the % operator of the other languages. :)

By way of explanation, notice that this formula:

 205558`mod`(ord c)`mod`7

maps I-0, X-1, C-2, M-3, V-4, L-5, D-6 as shown below:

 Roman   m  10^m   10^m`mod`9995
 -   -  -  -
   M 3   1000  1000
   D 6    100   500
   C 2    100   100
   L 5 10    50
   X 1 10    10
   V 4  1 5
   I 0  1 1

Noticing this, you can replace the 205558`mod`(ord c)`mod`7 magic
formula with a function that returns a string index (index() in
Perl and Python). I am sometimes overwhelmed by the quantity and
richness of all the functions in the GHC Haskell libraries.
I eventually found a Haskell solution that seemed to work:

{-# OPTIONS_GHC -fglasgow-exts -XOverloadedStrings -Wall #-}
import Data.ByteString.Char8 (elemIndex)
import Data.Maybe (fromJust)

rtoa c = 10^(fromJust (elemIndex c IXCMVLD))`mod`9995

I got this to work by trial and error and have no clue what this
-XOverloadedStrings and Data.ByteString.Char8 business really
means. If there is a better Haskell way of finding the numeric
index of a particular character in a string, please let me know.

Alternatively, you could write the rtoa function using an approach
taken from the original HaskellWiki solution:

rtoa = fromJust . flip lookup (zip IVXLCDM [1,5,10,50,100,500,1000])

What is your recommendation as to the best/most efficient way
of writing the rtoa function in Haskell?

Finally, here is an example complete test program.
Suggestions for improving the style of this code are welcome.

{-# OPTIONS_GHC -fglasgow-exts -Wall #-}
import Data.Char (toUpper)
import Data.List (concat, intersperse)

rtoa :: Char - Int
rtoa 'M' = 1000
rtoa 'D' =  500
rtoa 'C' =  100
rtoa 'L' =   50
rtoa 'X' =   10
rtoa 'V' =    5
rtoa 'I' =    1
rtoa r   = error $ Invalid rtoa 

Re: [Haskell-cafe] using phantom types to validate html

2009-06-07 Thread Thomas ten Cate
I have been thinking about this same problem a while ago, and found
that HaXml [1] can generate Haskell types from a DTD schema. However,
the code that you need to build HTML from that is quite verbose.

Being no expert in Haskell, I talked to Twan van Laarhoven, who came
up with something [2] that looks quite similar to your solution. It
allows you to write stuff like this:

test = html $ body [p [x,em y], ul [li 1, li 2]]

Your use of phantom types looks a lot like his. The main difference
with your solution is that Twan's generates strings right away,
instead of using an intermediate data structure. Whether or not this
is desirable depends on the application, I guess.

A slight disadvantage is that the monomorphism restriction doesn't
allow you to use the same value as children of two nodes of different
types. In practice, this will probably not occur often. The linked
file provides a workaround, but NoMonomorphismRestriction will of
course also work.

Generating such code for the full HTML spec, or any XML for that
matter, while also including more advanced validation rules like only
1 head section would be an interesting exercise. If you manage to
pull this off, I'm definitely interested.

Hope this helps,

Thomas

[1] http://www.cs.york.ac.uk/fp/HaXml/
[2] http://moonpatio.com/fastcgi/hpaste.fcgi/view?id=2581#a2582

On Sat, Jun 6, 2009 at 20:41, Mathijs Kwikbluescreen...@gmail.com wrote:
 Hi all,

 Please have a look at
 http://moonpatio.com/fastcgi/hpaste.fcgi/view?id=2575#a2575
 I wanted to use the typesystem to mandate businesslogic (in this case
 w3c validation rules).
 Thanks to some helpful people in #haskell I learned a bit about phantom types.
 Please let me know if I implemented them correctly.

 Also this little experiment raises some questions:
 The code becomes very verbose if there are more elements added or more
 rules to check.
 Since repetitive code can be a source of error, and hellish to
 maintain, I would like to know if there's some way to get this
 generated, or maybe there's some meta-programming stuff I don't know
 about.
 Another thing I can't figure out yet is how to do more advanced
 validation rules like an html element cannot have 2 head sections,
 or (made up) a span element isn't allowed to be a child(any level
 deep) of a p element.

 I think this would ask for an exponentially growing number of strange
 types and classes. Am I right?

 Just to be clear: this is just some practice to use the typesystem.
 I'm well aware that just using runtime validation checks will be a lot
 easier and clearer in most cases.

 Thanks,
 Mathijs
 ___
 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: using phantom types to validate html

2009-06-07 Thread Heinrich Apfelmus
Mathijs Kwik wrote:

 http://moonpatio.com/fastcgi/hpaste.fcgi/view?id=2575#a2575
 I wanted to use the typesystem to mandate businesslogic (in this case
 w3c validation rules).

You may want to have a look at Peter Thiemann's WASH/HTML

  http://www.informatik.uni-freiburg.de/~thiemann/WASH/#washhtml

which can statically ensure that only well-formed (with a few minor
caveats I think) HTML is generated.


Regards,
apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Question on rank-N polymorphism

2009-06-07 Thread Ryan Ingram
Well, I don't really recommend programming in dependently typed
languages right now :)

But if you must, Agda has been getting a lot of attention recently.
Also, the theorem prover Coq is based on the dependently-typed lambda
calculus.

In Haskell, giving a function an intersection type is generally done
with typeclasses.  You can write, for example:

class Fs a where
   type FsResult a
   fs :: a - FsResult a

data Fmap = Fmap
instance Fs Fmap where
   type FsResult a = forall f a b. Functor f = (f (a,b) - f a, f (a,b) - f b)
   fs Fmap = (fmap fst, fmap snd)

(although this seems unusable to me!)

You can also use Template Haskell to copy the argument:

-- I may have the syntax wrong here
fs :: a - Q Exp
fs a = [e| ($a fst, $a snd) ]

test :: (Int, String)
test = $(fs (`id` (1,2))

  -- ryan

On Sun, Jun 7, 2009 at 2:28 AM, Vladimir
Reshetnikovv.reshetni...@gmail.com wrote:
 Hi Ryan,

 Thanks for your explanation. What language with dependent types would
 you recommend me to look at?

 Now I am studying rank-N polymorphism in Haskell and trying to
 generalize some combinators in my libraries to multitypes. This is how
 I came to this question.

 Thanks,
 Vladimir

 On 6/7/09, Ryan Ingram ryani.s...@gmail.com wrote:
 This is a really interesting question.

 So, fs is well-typed in Haskell:
    fs :: (((a,a) - a) - t) - (t,t)
 i.e.
    fs id :: ((a,a) - a, (a,a) - a)

 However, I believe what you are asking is for fs to be equivalent to
 the following:
 fs2 f g = (f fst, g snd)

 which has the type
 fs2 :: (((a, b) - a) - t) - (((a1, b1) - b1) - t1) - (t, t1)

 except with the argument broadcast polymorphically to both positions.

 This means the argument must have the multitype

 g :: ((a,b) - a) - t  /\  ((a1,b1) - b1) - t1

 for some t and t1 which are functions of a,b and a1,b1.

 Unfortunately I don't believe it is possible to encode this type in
 System F or System F(c), the underlying lambda-calculus used by GHC,
 so Haskell isn't going to be able to solve this problem.  But there
 are statically typed languages which can solve this problem.

 You can take the big hammer of dependent types, and write fs something
 like this (not Haskell; this is a dependently-typed language):

 typeof_g :: (Type - Type - Type - Type) - Type
 typeof_g res_type = (a :: Type) - (b :: Type) - (c :: Type) -
 ((a,b) - c) - res_type a b c

 fs :: (res_type :: Type - Type - Type - Type) - (g :: typeof_g
 res_type)
   - (a :: Type) - (b :: Type) - (res_type a b a, res_type a b b)
 fs _ g a b = (g a b a fst, g a b b snd)

 So, you'd write fs id like this:
 fs (\a b c. (a,b) - c) (\a b c. id ((a,b) - c))

 This is a fascinating problem, though.  What put you on this path?

   -- ryan

 On Sat, Jun 6, 2009 at 3:06 PM, Vladimir
 Reshetnikovv.reshetni...@gmail.com wrote:
 Hi,

 I have the following code:

 
 fs g = (g fst, g snd)
 examples = (fs fmap, fs liftA, fs liftM, fs id, fs ($(1,2)), fs
 ((,)id), fs (:[]), fs repeat)
 

 The idea is that fs accepts a polymorphic function as its argument.
 What type signature can I specify for f in order to compile this code?
 If it is not possible in Haskell, is there another language with
 static typing which allows this?

 Thanks,
 Vladimir
 ___
 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: totally confused about Haskell namespace issue conventions

2009-06-07 Thread Maurí­cio
as far as namespace is concerned what is division between a module's 
name and it's associated .cabal with it's Hs-Source-Dirs directive? This 
is kinda' absolute vs relative path I think.


Vasili,

First, let's talk about Haskell modules, without mentioning
cabal.

When Haskell 98 standard came, modules had just a name, like,
say, 'Complex'. You can still see those names in GHC library
for compatibility:

http://www.haskell.org/ghc/docs/latest/html/libraries

Another interesting think you can see in that link is the
separation of modules into 'packages'. Right to the name of
every module there's a package name, like 'haskell98', 'base',
'stm-2.1.1.2' etc.

GHC and others adopted the convention of using dot in module
names to have a standard way of showing hierarchy between
modules. There's also a convention used in GHC (and others?) of
allowing only one module per file and, when looking for such file
(as in --make) compose the search path with the module name,
replacing dots by the start of a sub-directory name. So: suppose
your search path (a colon separate list of directories) is
'.:/hs:sub' and GHC wants a file for module Data.Our.Test. Then
it looks for:

./Data.Our.Test
/hs/Data.OurTest
./sub/Data.OurTest

You can find details on that (like how to add to the search
path) here:

http://www.haskell.org/ghc/docs/latest/html/users_guide/separate-compilation.html

Now about .cabal file. When you use it, it helps you generate a
package. In 'hs-source-dirs' you say what is the search path. In
'exposed-modules' you say wich modules are going to be seen
by users of your package.  You can also use 'other-modules'
to name modules your package needs but are not going to be
visible to other packages.

Just say if anything is not clear. Best,
Maurício

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


Re: [Haskell-cafe] Question on rank-N polymorphism

2009-06-07 Thread Wouter Swierstra

The idea is that fs accepts a polymorphic function as its argument.
What type signature can I specify for f in order to compile this code?


As you said yourself, you need to add a type signature to fs:


{-# LANGUAGE RankNTypes #-}




fs :: ((forall a . ((a, a) - a)) - t) - (t, t)
fs g = (g fst, g snd)

examples = (fs id, fs repeat, fs (\x - [x]), fs ((,)id))



Hope this helps,

  Wouter


This message has been checked for viruses but the contents of an attachment
may still contain software viruses, which could damage your computer system:
you are advised to perform your own checks. Email communications with the
University of Nottingham may be monitored as permitted by UK legislation.

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


Re: [Haskell-cafe] Roman to Decimal Algorithms

2009-06-07 Thread Tillmann Rendel

Hi Andrew,

Andrew Savige wrote:
  Noticing this, you can replace the 205558`mod`(ord c)`mod`7 magic

formula with a function that returns a string index (index() in
Perl and Python). I am sometimes overwhelmed by the quantity and
richness of all the functions in the GHC Haskell libraries.


Have you tried hoogle?

  http://haskell.org/hoogle/?hoogle=String+-%3E+Maybe+Int

This suggests Data.List.elemIndex.

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


Re: [Haskell-cafe] comprehension problem

2009-06-07 Thread ptrash

Cool, thanks a lot.



Ross Mellgren wrote:
 
 P Float is the constructor to create a value of this type, similar to  
 data declarations.
 
 That is, 0.5 :: Float, P 0.5 :: Probability
 
 The {} notation after D creates a record accessor, also similar to  
 data declarations. It's equivalent to making an unD that unwraps the  
 value yourself:
 
 newtype Dist a = D { unD :: [(a, Probability)] }
 
 is the same as
 
 newtype Dist a = D [(a, Probability)]
 
 unD :: Dist a - [(a, Probability)]
 unD (D x) = x
 
 a in Dist a is a type variable, for example you could have Dist Float  
 (containing [(Float, Probability)]), or Dist String (containing  
 [(String, Probability)])
 
 -Ross
 
 On Jun 3, 2009, at 4:01 PM, ptrash wrote:
 

 Hi,

 what does this to code rows mean:

 newtype Probability = P Float
 newtype Dist a = D {unD :: [(a, Probability)]}

 newtype definies a new type called Probability. But what does P  
 Float mean?

 And what is the a in Dist a?
 What does D {...} mean?

 Thanks for your help.
 -- 
 View this message in context:
 http://www.nabble.com/comprehension-problem-tp23858359p23858359.html
 Sent from the Haskell - Haskell-Cafe mailing list archive at  
 Nabble.com.

 ___
 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
 
 

-- 
View this message in context: 
http://www.nabble.com/comprehension-problem-tp23858359p23913380.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


[Haskell-cafe] Change value of a variable

2009-06-07 Thread ptrash

Hi, how can I change the value of a variable.

let x = 1
x = x + 2 

First I set the value of x to 1. Then I want to increase it by 2. This way
doesn't work, because I think it is a infinite expression.

Is there a way to change the value?


-- 
View this message in context: 
http://www.nabble.com/Change-value-of-a-variable-tp23913404p23913404.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Bulat Ziganshin
Hello ptrash,

Sunday, June 7, 2009, 9:41:56 PM, you wrote:

 Hi, how can I change the value of a variable.

there are no variables in haskell :)))

x, like any other identifier, is a value. when you translate to Haskell
some algo that needs to update variable contents, you may either

1) use recursion:

length (x:xs) = 1 + length xs
length [] = 0

2) use references (IORef). like in C, references by itself are non-mutable,
but they point to values that can be mutated




-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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


Re: [Haskell-cafe] Roman to Decimal Algorithms

2009-06-07 Thread Martijn van Steenbergen

Hi Andrew,

I haven't read your whole message but if shortness is your goal, here 
are some ideas:


Andrew Savige wrote:

rtoa c = 10^(205558`mod`(ord c)`mod`7)`mod`9995

I'm not suggesting that magic formulae are useful outside of golf and
this second rtoa function, though shorter, is much less clear. I might
add that this particular magic formula appears to be less useful in
Haskell golf than the other languages because `mod` is five times
longer than the % operator of the other languages. :)


Why not rename mod like so?

(%)=mod
rtoa c=10^(205558%ord c%7)%9995


Alternatively, you could write the rtoa function using an approach
taken from the original HaskellWiki solution:

rtoa = fromJust . flip lookup (zip IVXLCDM [1,5,10,50,100,500,1000])


You can write this as:

Just rtoa=flip lookup (zip IVXLCDM [1,5,10,50,100,500,1000])

Which is another few characters shorter. :-)

HTH,

Martijn.

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


Re: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Keith Sheppard
I guess the short answer is that it is not possible. 'x' is immutable
and if you want a different value than 'x' that expression has to be
given a different name like:
let x=1
y=x+2
...

But I'm not sure if that helps you. Haskell does things very
differently than the imperative languages and forces you to think
differently about how to solve problems. When I started learning
haskell I found that I had to think more about composing/decomposing
expressions and less about sequencing actions and side effects like
you do in most of the more popular languages (I really have come to
prefer the Haskell way). I think we may be able to give a more helpful
answer if give a more high level algorithm/use case... why do you want
to change the value of x

-Keith

On Sun, Jun 7, 2009 at 1:41 PM, ptrashptr...@web.de wrote:

 Hi, how can I change the value of a variable.

 let x = 1
 x = x + 2

 First I set the value of x to 1. Then I want to increase it by 2. This way
 doesn't work, because I think it is a infinite expression.

 Is there a way to change the value?


 --
 View this message in context: 
 http://www.nabble.com/Change-value-of-a-variable-tp23913404p23913404.html
 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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




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


Re[2]: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Bulat Ziganshin
Hello ptrash,

Sunday, June 7, 2009, 11:03:55 PM, you wrote:

 Hi, thanks for the answers.

 I want to make something like a counter. I have written a recursive method
 which for example runs x times and counts how many times it runs, and also
 count some other thinks. Add the end I want a statistic about certain thinks
 returned by the method.

then the best way is to add this counter as one more param of
recursive procedure



-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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


Re: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Deniz Dogan
2009/6/7 ptrash ptr...@web.de:

 Hi, thanks for the answers.

 I want to make something like a counter. I have written a recursive method
 which for example runs x times and counts how many times it runs, and also
 count some other thinks. Add the end I want a statistic about certain thinks
 returned by the method.

Depending on exactly what you want, you may or may not want to look
into monads, specifically the State or Writer monad.  Could you give
some more specific details on what you are trying to accomplish?

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


Re: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Ketil Malde
ptrash ptr...@web.de writes:

 I want to make something like a counter. I have written a recursive method
 which for example runs x times and counts how many times it runs, and also
 count some other thinks. Add the end I want a statistic about certain thinks
 returned by the method.

Keep in mind that a function's result depends only on its parameters,
so any state you want to retain must be part of the parameters.

So you might be looking for something like:

  iterateN x f y = if x == 0 then y else iterateN (x-1) f (f y)

-k
-- 
If I haven't seen further, it is by standing in the footprints of giants
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Random Number

2009-06-07 Thread ptrash

Hi, 

is the are way (or a build in method) in haskell to get a random number from
a number bottom to a number top?

Something like

let randomNumber = random 1 30

to get a random number between 1 and 30.
-- 
View this message in context: 
http://www.nabble.com/Random-Number-tp23914474p23914474.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Change value of a variable

2009-06-07 Thread ptrash

What i am exactly to do is this:

I have a list of pupils (type Pupil = (Name, Grade)) where I store the name
of the pupil and which grade he has. No I want to get the number (and
average number) of each grade. Something like 10 Pupils have a A (23%), 2
Pupils have a B ( 4 %) etc
-- 
View this message in context: 
http://www.nabble.com/Change-value-of-a-variable-tp23913404p23914558.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

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


Re: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Jeff Heard
Sounds like a fold to me. Try looking at the doc of either foldl/r/l'
or mapAccum depending on what you want..  Then write a function for
one iteration that returns the value from that iteration combined with
the value from the last iteration

-- Jeff

On Sun, Jun 7, 2009 at 3:44 PM, ptrashptr...@web.de wrote:

 What i am exactly to do is this:

 I have a list of pupils (type Pupil = (Name, Grade)) where I store the name
 of the pupil and which grade he has. No I want to get the number (and
 average number) of each grade. Something like 10 Pupils have a A (23%), 2
 Pupils have a B ( 4 %) etc
 --
 View this message in context: 
 http://www.nabble.com/Change-value-of-a-variable-tp23913404p23914558.html
 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

 ___
 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] Random Number

2009-06-07 Thread José Prous
look in System.Random
randomRIO :: (Random a) = (a, a) - IO a

you can do
randomNumber-randomRIO (1,30)


On Sun, Jun 7, 2009 at 3:33 PM, ptrash ptr...@web.de wrote:


 Hi,

 is the are way (or a build in method) in haskell to get a random number
 from
 a number bottom to a number top?

 Something like

 let randomNumber = random 1 30

 to get a random number between 1 and 30.
 --
 View this message in context:
 http://www.nabble.com/Random-Number-tp23914474p23914474.html
 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

 ___
 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] Random Number

2009-06-07 Thread Krzysztof Skrzętnicki
On Sun, Jun 7, 2009 at 21:33, ptrashptr...@web.de wrote:

 Hi,

 is the are way (or a build in method) in haskell to get a random number from
 a number bottom to a number top?

 Something like

 let randomNumber = random 1 30

 to get a random number between 1 and 30.

I don't mean to be rude, but did you even tried to read the
documentation? The function you want is here:
http://www.haskell.org/ghc/docs/latest/html/libraries/random/System-Random.html

Before you ask any other questions please read this essay:
http://mattgemmell.com/2008/12/08/what-have-you-tried

Best regards

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


Re: [Haskell-cafe] Question on rank-N polymorphism

2009-06-07 Thread Ryan Ingram
The most interesting example is

fs ($ (1, 2))

Which I haven't been able to make typecheck.

Here's some well-typed code:

 fs2 f g = (f fst, g snd)
 ab f = f ('a', b)
 test = fs2 ab ab
 -- test2 = fs ab

The question is, is it possible to write fs such that your examples
typecheck and test2 also typechecks?

I find this example interesting because it's the smallest example I've
seen of a well-typed program which would just work in Scheme or
Lisp, but which we can't assign a type to in Haskell.

  -- ryan

On Sun, Jun 7, 2009 at 9:20 AM, Wouter Swierstraw...@cs.nott.ac.uk wrote:
 The idea is that fs accepts a polymorphic function as its argument.
 What type signature can I specify for f in order to compile this code?

 As you said yourself, you need to add a type signature to fs:

 {-# LANGUAGE RankNTypes #-}


 fs :: ((forall a . ((a, a) - a)) - t) - (t, t)
 fs g = (g fst, g snd)

 examples = (fs id, fs repeat, fs (\x - [x]), fs ((,)id))


 Hope this helps,

  Wouter


 This message has been checked for viruses but the contents of an attachment
 may still contain software viruses, which could damage your computer system:
 you are advised to perform your own checks. Email communications with the
 University of Nottingham may be monitored as permitted by UK legislation.

 ___
 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[2]: [Haskell-cafe] Change value of a variable

2009-06-07 Thread Bulat Ziganshin
Hello ptrash,

Sunday, June 7, 2009, 11:44:18 PM, you wrote:

 I have a list of pupils (type Pupil = (Name, Grade)) where I store the name
 of the pupil and which grade he has. No I want to get the number (and
 average number) of each grade. Something like 10 Pupils have a A (23%), 2
 Pupils have a B ( 4 %) etc

it doesn't need variables, you just going to change your mind, Neo :)

the way it may be calculated in FP is
1) sort list by grades
2) group it by grades
3) count number of elements in each group

just look into Data.List functions. or, alternatively, read
A Tour of the Haskell Prelude

http://haskell.org/ghc/docs/latest/html/libraries/base/Data-List.html
http://undergraduate.csse.uwa.edu.au/units/CITS3211/lectureNotes/tourofprelude.html

-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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


Re: [Haskell-cafe] Monad transformer responsibilities

2009-06-07 Thread Henning Thielemann
Ryan Ingram schrieb:
From what I understand, the current best practices are to build your
 package dependencies like so:
 
 ParsecMyMonadT
  MyMonadT_Parsec   -- orphan instances go here
  ProjectPackage
 
 This does mean splitting up your project into three packages, but
 decouples the orphan instance into its own package where it can do the
 least damage :)


+1

You may also document in MyMonadT where the official orphan instance can
be found (in MyMonadT_Parsec) and that no other instance should be defined.

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


Re: [Haskell-cafe] Random Number

2009-06-07 Thread Iain Barnett

On 7 Jun 2009, at 8:33 pm, ptrash wrote:



Hi,

is the are way (or a build in method) in haskell to get a random  
number from

a number bottom to a number top?

Something like

let randomNumber = random 1 30

to get a random number between 1 and 30.



rand :: Int - Int - IO Int
rand low high = getStdRandom (randomR (low,high))

this worked for me, I also had quite a few random questions on here a  
few months ago! :)


Beware it is an IO int.


On 7 Jun 2009, at 8:55 pm, Krzysztof Skrzętnicki wrote:

I don't mean to be rude, but did you even tried to read the
documentation? The function you want is here:
http://www.haskell.org/ghc/docs/latest/html/libraries/random/System- 
Random.html


Before you ask any other questions please read this essay:
http://mattgemmell.com/2008/12/08/what-have-you-tried

Best regards

Krzysztof Skrzętnicki




Bit harsh isn't it? He asked for an example function, not an entire  
program.


Iain





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


Re: [Haskell-cafe] Random Number

2009-06-07 Thread michael rice
Good essay.

Try this one for a laugh:


http://www.mcs.vuw.ac.nz/comp/Publications/CS-TR-02-9.abs.html


A good place to begin is PDF pg. 19.

Michael


--- On Sun, 6/7/09, Krzysztof Skrzętnicki gte...@gmail.com wrote:

From: Krzysztof Skrzętnicki gte...@gmail.com
Subject: Re: [Haskell-cafe] Random Number
To: ptrash ptr...@web.de
Cc: haskell-cafe@haskell.org
Date: Sunday, June 7, 2009, 3:55 PM

On Sun, Jun 7, 2009 at 21:33, ptrashptr...@web.de wrote:

 Hi,

 is the are way (or a build in method) in haskell to get a random number from
 a number bottom to a number top?

 Something like

 let randomNumber = random 1 30

 to get a random number between 1 and 30.

I don't mean to be rude, but did you even tried to read the
documentation? The function you want is here:
http://www.haskell.org/ghc/docs/latest/html/libraries/random/System-Random.html

Before you ask any other questions please read this essay:
http://mattgemmell.com/2008/12/08/what-have-you-tried

Best regards

Krzysztof Skrzętnicki
___
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] Roman to Decimal Algorithms

2009-06-07 Thread Andrew Savige

Tillmann Rendel wrote:
 Have you tried hoogle?

  http://haskell.org/hoogle/?hoogle=String+-%3E+Maybe+Int

 This suggests Data.List.elemIndex.

Hadn't heard of hoogle before. Will use it from now on though. :)
Hoogle's suggestion of Data.List.elemIndex works like a charm.

Thanks,
/-\



  Need a Holiday? Win a $10,000 Holiday of your choice. Enter 
now.http://us.lrd.yahoo.com/_ylc=X3oDMTJxN2x2ZmNpBF9zAzIwMjM2MTY2MTMEdG1fZG1lY2gDVGV4dCBMaW5rBHRtX2xuawNVMTEwMzk3NwR0bV9uZXQDWWFob28hBHRtX3BvcwN0YWdsaW5lBHRtX3BwdHkDYXVueg--/SIG=14600t3ni/**http%3A//au.rd.yahoo.com/mail/tagline/creativeholidays/*http%3A//au.docs.yahoo.com/homepageset/%3Fp1=other%26p2=au%26p3=mailtagline
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Roman to Decimal Algorithms

2009-06-07 Thread Andrew Savige

Martijn van Steenbergen wrote:
 Why not rename mod like so?

 (%)=mod
 rtoa c=10^(205558%ord c%7)%9995

Thanks Martijn. My first Haskell golfing tip. :)

I found I had to write it with an extra set of parens to get it to work:

rtoa c=(10^(205558%ord c)%7)%9995

Though it wasn't my original intention to play Haskell golf, assuming
upper case Roman Numerals, we can now write the whole thing as:

(%)=mod
romanToInt=foldl1(\t n-t+n-t%n*2).map(\c-(10^(205558%ord c)%7)%9995)

Can anyone shorten that further?

Thanks,
/-\



  Need a Holiday? Win a $10,000 Holiday of your choice. Enter 
now.http://us.lrd.yahoo.com/_ylc=X3oDMTJxN2x2ZmNpBF9zAzIwMjM2MTY2MTMEdG1fZG1lY2gDVGV4dCBMaW5rBHRtX2xuawNVMTEwMzk3NwR0bV9uZXQDWWFob28hBHRtX3BvcwN0YWdsaW5lBHRtX3BwdHkDYXVueg--/SIG=14600t3ni/**http%3A//au.rd.yahoo.com/mail/tagline/creativeholidays/*http%3A//au.docs.yahoo.com/homepageset/%3Fp1=other%26p2=au%26p3=mailtagline
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Building network package on Windows

2009-06-07 Thread Iavor Diatchki
Hello,
Here is an update, in case anyone else runs into the same problem.

My understanding, is that the problem was caused by a mistake in the
configure script for the network package, which after (correctly)
detecting that IPv6 functionality was not available on my platform, it
(incorrectly) tried to gain this functionality by redefining the
version of my platform.  Concretely, apparently I have Windows Vista
Basic Home Edition, which seems to identify itself as version 0x400,
while the missing functions are only available on versions of windows
= 0x501.

My workaround was to:
  1. checkout the network package from the repository on code.haskell.com
  2. modify configure.ac to comment out the section where it sets the
windows version to 0x501
  3. autoreconf
  4. build using the usual cabal way

Another thing to watch out for:  if you already have packages that
were built against the old version of network, they will continue to
use that.  So, I had to:
  1. remove all of these packages,
  2. remove the old version of network (to avoid confusion), and
  3. then resintall the packages.
It would be nice if we had a more automatic way to do that (perhaps we
do, but I don't know it?).  It seems that if this is not done GHC
could panic, which is what happened to me.  I am not sure why that
happened but I am guessing that it was related to the fact that
interface to the package changed without its version changing.

In general, it seems a bad idea that the same version of the network
package exhibits different APIs, depending on the configuration of the
underlying system.

-Iavor







On Sat, Jun 6, 2009 at 9:43 PM, Iavor Diatchkiiavor.diatc...@gmail.com wrote:
 Hi,
 I have been trying to build the package network from hackage
 (version 2.2.1.3) on Windows Vista, and I could really use some help.

 Building on the command line, or under cygwin completely failed
 (command line due to cabal not being able to execute
 something---possibly configure---although it would not say; cygwin
 first due to lack of gcc, which is tested but, apparently, the outcome
 ignored, and after gcc was installed some incompatibility with the
 header files which were detected but reported unusable).

 I managed to build the library under MinGW with msys without serious
 obstacles.  I can also build my package against the result and all is
 well.  Unfortunately, if I try to use my package to build an
 executable application I get a linker error, reporting a missing
 symbol during linking:
 C:\Users\diatchki\AppData\Roaming\cabal\network-2.2.1.3\ghc-6.10.3/libHSnetwork-2.2.1.3.a(Socket.o):fake:(.text+0xb014):
 undefined reference to `getnameinfo'
 collect2: ld returned 1 exit status

 Now, getnameinfo is present in the header files, and it is also
 defined in the library ws2_32.a which is being passed to GHC so I am
 not sure what is going on.  Any ideas?  Searching the web suggests
 that the problem may be somehow related to the standard calling
 conventions but I don't really understand.  Also, if I understand
 correctly, this functionality is related to IPv6 support, which I do
 not need at the moment, so it would be great if it could be easily
 disabled in some way.

 Any ideas, suggestion, workarounds, etc. would be greatly appreciated,
 -Iavor

 PS: I am using GHC 6.10.3

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


Re: [Haskell-cafe] ghci: can't load .so/.DLL for: m (addDLL: could not load DLL) / is there a libm.dll for Windows

2009-06-07 Thread wren ng thornton

Mark Wassell wrote:

Hello,

I get this when using the logfloat package via ghci on Windows. For example

*Main :m + Data.Number.LogFloat
*Main Data.Number.LogFloat logFloat (1.0::Float)
Loading package syb ... linking ... done.
Loading package array-0.2.0.0 ... linking ... done.
Loading package logfloat-0.12.0.1 ... can't load .so/.DLL for: m 
(addDLL: could not load DLL)

*Main Data.Number.LogFloat

When compiling the program using ghc, it works fine. This was previously 
reported as a ghc bug http://hackage.haskell.org/trac/ghc/ticket/3242 
where the reporter was getting the message using hipmunk. The ticket was 
closed as the issue was deemed to be a bug in hipmunk, not GHC.


As the ticket reporter asked, what is the correct approch to get around 
this? I have tried specifying -lm on ghci startup line but my system 
doesn't seem to have a libm.dll or anything similar. Is there such a thing?



I don't know about a general solution, but I'd love to hear one.

This is a known issue for the logfloat package using GHCi on Windows, 
documented[1] in the ./INSTALL file under the Windows FFI section. When 
using the compiler, the C functions are provided by libmingwex.a which 
is bundled with GHC, but for some reason the interpreter doesn't find 
the same library.


If you need to run code in GHCi and want a workaround, you can recompile 
the library disabling the use of the FFI by passing the -f-useFFI flag 
to `runhaskell Setup.hs configure`. (I'm not sure how to do that if 
you're using the cabal-install tool.) This will degrade the precision of 
miniscule LogFloat values, but should otherwise work fine.



[1] As of version 0.12.0.3 which is available from darcs:

http://community.haskell.org/~wren/logfloat

The only differences between 0.12.0.3 and 0.12.0.1 are in the metadata 
files: INSTALL, TODO, VERSION.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] How to convert DiffTime to a number?

2009-06-07 Thread Magicloud Magiclouds
Hi,
  Documents said that DiffTime could treat as how many seconds. So
how to convert it to a number of seconds?

Thanks.
-- 
竹密岂妨流水过
山高哪阻野云飞
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: How to convert DiffTime to a number?

2009-06-07 Thread Magicloud Magiclouds
Ah, floor $ toRational dt.

On Mon, Jun 8, 2009 at 1:09 PM, Magicloud
Magicloudsmagicloud.magiclo...@gmail.com wrote:
 Hi,
  Documents said that DiffTime could treat as how many seconds. So
 how to convert it to a number of seconds?

 Thanks.
 --
 竹密岂妨流水过
 山高哪阻野云飞




-- 
竹密岂妨流水过
山高哪阻野云飞
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe