Re: runghc printing result of main when main is not IO ()

2007-08-30 Thread Simon Marlow

Tomasz Zielonka wrote:

Hello!

Consider:

$ cat R.hs 
main = return [()]
$ runghc R.hs 
[()]


This was a bit surprising for me, because I thought that runghc
mimics the way a compiled program behaves.


This doesn't happen with 6.6.1, I believe we fixed it at some point by 
having runghc perform main  return () instead of just main.


Cheers,
Simon
___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: runghc printing result of main when main is not IO ()

2007-08-30 Thread Tomasz Zielonka
On Thu, Aug 30, 2007 at 08:33:37AM +0100, Simon Marlow wrote:
 Tomasz Zielonka wrote:
 Hello!
 Consider:
 $ cat R.hs main = return [()]
 $ runghc R.hs [()]
 This was a bit surprising for me, because I thought that runghc
 mimics the way a compiled program behaves.

 This doesn't happen with 6.6.1, I believe we fixed it at some point by 
 having runghc perform main  return () instead of just main.

Great! I'm sorry for not checking with a recent version :-/

Best regards
Tomek
___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re[2]: Data.HashTable.hashInt seems somewhat sub-optimal

2007-08-30 Thread Bulat Ziganshin
Hello Jan-Willem,

you may be interested to read hashing papers mentioned at
http://www.encode.ru/forums/index.php?action=vthreadforum=1topic=413


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1616: segfault in generated file when using NOINLINE

2007-08-30 Thread GHC
#1616: segfault in generated file when using NOINLINE
-+--
Reporter:  guest |Owner: 
Type:  bug   |   Status:  new
Priority:  normal|Milestone:  6.8
   Component:  Compiler  |  Version:  6.6.1  
Severity:  normal|   Resolution: 
Keywords:|   Difficulty:  Unknown
  Os:  Linux | Testcase: 
Architecture:  x86   |  
-+--
Comment (by simonmar):

 I've done some analysis, but I want to check with Simon PJ about whether
 GHC is doing something wrong here.  I can definitely fix/workaround the
 bug in Happy: the problem is centered around the fact that Happy uses
 `()-()` as its unknown type, when it should really be using `Any` or
 `forall a.a`.  I've pushed a fix for Happy to its darcs repository.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1616
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1650: .boot modules interact badly with the ghci debugger

2007-08-30 Thread GHC
#1650: .boot modules interact badly with the ghci debugger
+---
  Reporter:  mnislaih   |  Owner:  
  Type:  bug| Status:  new 
  Priority:  high   |  Milestone:  6.8 
 Component:  GHCi   |Version:  6.7 
  Severity:  normal |   Keywords:  debugger
Difficulty:  Unknown| Os:  Unknown 
  Testcase:  break022 break023  |   Architecture:  Unknown 
+---
If a boot module is loaded _after_ its normal counterpart, which can
 happen, the module ends up with empty modBreaks info, which leads to
 errors while debugging.
 It looks like boot modules take the place of their normal counterparts in
 the HomePackageTable perhaps?
 An example:


 {{{
 GHCi, version 6.7.20070826: http://www.haskell.org/ghc/  :? for help
 Loading package base ... linking ... done.
 Prelude :l C
 [1 of 4] Compiling B[boot]  ( B.hs-boot, interpreted )
 [2 of 4] Compiling A( A.hs, interpreted )
 [3 of 4] Compiling B( B.hs, interpreted )
 [4 of 4] Compiling C( C.hs, interpreted )
 Ok, modules loaded: B, B, C, A.
 *C :! touch A.hs
 *C :r
 [1 of 4] Compiling B[boot]  ( B.hs-boot, interpreted )
 [2 of 4] Compiling A( A.hs, interpreted )
 Ok, modules loaded: B, B, C, A.
 *C :break a
 Breakpoint 0 activated at A.hs:4:0-8
 *C a ()
 Stopped at A.hs:4:0-8
 _result :: a = _
 3
 4  a x = b x
 [A.hs:4:0-8] *C :st
 Stopped at A.hs:4:6-8
 _result :: () = _
 x :: () = ()
 3
 4  a x = b x
 [A.hs:4:6-8] *C :st
 *** Exception: Error in array index
 }}}

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1650
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1651: panic when interactively evaluating expression with a family type

2007-08-30 Thread GHC
#1651: panic when interactively evaluating expression with a family type
--+-
  Reporter:  chak |  Owner: 
  Type:  bug  | Status:  new
  Priority:  normal   |  Milestone: 
 Component:  Compiler (Type checker)  |Version:  6.7
  Severity:  normal   |   Keywords: 
Difficulty:  Unknown  | Os:  Unknown
  Testcase:   |   Architecture:  Unknown
--+-
{{{
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE EmptyDataDecls #-}

 newtype Succ a = Succ a deriving Show
 dataZero   = Zero
 instance Show Zero where show _ = Zero

 type family Add a b
 type instance Add Zero a = a
 type instance Add (Succ n) m = Succ (Add n m)

 add :: a - b - Add a b
 add = undefined

 okay = show $ add Zero Zero
 bad  = add Zero Zero

 {- ghci transcript:

 *Main okay
 Zero
 *Main bad
 ghc-6.7.20070828: panic! (the 'impossible' happened)
   (GHC version 6.7.20070828 for i386-unknown-linux):
 readFilledBox t_a1D9{tv} [box]

 Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

 *Main show bad

 interactive:1:0:
 No instance for (Show (Add Zero Zero))
   arising from a use of `show' at interactive:1:0-7
 Possible fix:
   add an instance declaration for (Show (Add Zero Zero))
 In the expression: show bad
 In the definition of `it': it = show bad
 -}
 }}}
 The panic arises as follows: `tcGhciStmts` calls `TcMatches.tcDoStmt` to
 type check `it - bad`, which in turn evaluates
 {{{
  withBox liftedTypeKind $ \ pat_ty -
tcMonoExpr rhs (mkAppTy m_ty pat_ty)
 }}}
 The `withBox` executes the `readfilledBox` that causes the panic, as
 `tcMonoExpr` promises to fill the boxes in its second argument.  This
 promise is not fulfilled, as `tcMonoBox` defers the match `Add Zero Zero ~
 IO t_ayP`.

 Further up the call chain `tcGhciStmts` will eventually simplify the LIE
 and would discover the type mismatch (and hence abandon Plan A, of which
 all this is part).  Unfortunately, we never get there due to `withBox`s
 attempt to read `t_avP`.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1651
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1651: panic when interactively evaluating expression with a family type

2007-08-30 Thread GHC
#1651: panic when interactively evaluating expression with a family type
+---
Reporter:  chak |Owner: 
Type:  bug  |   Status:  new
Priority:  normal   |Milestone: 
   Component:  Compiler (Type checker)  |  Version:  6.7
Severity:  normal   |   Resolution: 
Keywords:   |   Difficulty:  Unknown
  Os:  Unknown  | Testcase: 
Architecture:  Unknown  |  
+---
Comment (by chak):

 BTW, this bug was reported (and the example provided) by sjanssen from
 #haskell.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1651
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: runghc printing result of main when main is not IO ()

2007-08-30 Thread Donald Bruce Stewart
tomasz.zielonka:
 On Thu, Aug 30, 2007 at 08:33:37AM +0100, Simon Marlow wrote:
  Tomasz Zielonka wrote:
  Hello!
  Consider:
  $ cat R.hs main = return [()]
  $ runghc R.hs [()]
  This was a bit surprising for me, because I thought that runghc
  mimics the way a compiled program behaves.
 
  This doesn't happen with 6.6.1, I believe we fixed it at some point by 
  having runghc perform main  return () instead of just main.
 
 Great! I'm sorry for not checking with a recent version :-/

It was a cute feature though -- great for demos where you can avoid a
print statement ;)

-- Don
___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re[4]: Data.HashTable.hashInt seems somewhat sub-optimal

2007-08-30 Thread Bulat Ziganshin
Hello Jan-Willem,

Thursday, August 30, 2007, 4:28:28 PM, you wrote:

 http://www.encode.ru/forums/index.php?action=vthreadforum=1topic=413

 Not only did I read them, I tried out the Bob Jenkins hash function!

i don't propose to use this function, this page just contain a lot of
various hash functions together with discussions. in particular, there
is info about multiplicative hash which is close to your hashing
scheme

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1209: getMBlocks: misaligned block returned

2007-08-30 Thread GHC
#1209: getMBlocks: misaligned block returned
-+--
Reporter:  CBa   |Owner:  simonmar
Type:  bug   |   Status:  new 
Priority:  normal|Milestone:  6.6.2   
   Component:  Runtime System|  Version:  6.4.2   
Severity:  normal|   Resolution:  
Keywords:  darcs, windows, memory, VirtualAlloc  |   Difficulty:  Unknown 
  Os:  Windows   | Testcase:  
Architecture:  x86   |  
-+--
Changes (by simonmar):

  * owner:  = simonmar

Comment:

 I have a fix for this waiting to be validated

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1209
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


RE: Data.HashTable.hashInt seems somewhat sub-optimal

2007-08-30 Thread Simon.Frankau
Jan-Willem Maessen wrote: 
 Sigh.
 
 I've included a fix below, but I don't have a standard GHC checkout  
 available to me (only the test sandbox I used to get the code in the  
 first place) so I haven't generated a patch.  Note the mentioned  
 reasonability tests, which hopefully should forestall such obvious  
 infelicities in future.

Hi.

Sorry to be a bit negative, but I don't think the hash function you
suggest is good for a number of reasons:

1) I don't think you're implementing the algorithm Thorkil Naur
suggests. I believe (although I haven't had the time to check) that the
scheme is equivalent to using the output of mulLo, not mulHi. So, we
lose whatever theoretical underpinnings the original has.

2) Signed multiplication is being used. I think unsigned multiplication
is probably necessary to get the intended behaviour. For example, with
unsigned multiplication, multiplying by the original 'golden' and taking
the the top 32 bits is equivalent to multiplying by the golden ratio,
while with signed multiplication it is equivalent to multiplying by the
golden ratio minus one.

3) The original code was equivalent to a multiplication by a fixed point
number less than one. The new code is equivalent to multiplying by a
fixed point number slightly greater than one. I think this misses an
important behaviour which hash functions should have: They should smear
out ranges of integers. Why? People tend to hash lists with a fold
which, for example, hashes the previous result, and then xors in or adds
the new value. If the hashes of small integers are small integers, we
have the situation where transposing two elements of a list of small
integers, and making a minor adjustment to one of those values will
result in a clash. In other words, we're not making effective use of the
available range of numbers. Hence, for example, the use of 'magic' in
hashString.

I understand your concerns that

A) The hash function should be cheap to evaluate, and need not be
particularly strong.

However, It should not be unnecessarily weak. A decent hash should allow
small sets of values (e.g. short lists of ints) to hash to unique
values. If they do not, scaling falls apart, since rehashing with larger
table sizes will not necessarily shorten the longer hash chains. I think
we can find a hash function with better behaviour which is still cheap
to evaluate.

B) If the low bits are zero, it would be nice if the low bits of the
hash weren't always zero.

A scheme using mulLo doesn't have good behaviour here. Possible
variations which are quick to evaluate and have this property are:
 * xor/add together the output of mulHi and mulLo
 * Put a rotation step in.
The downside to these is that these 'adjustments' could well break neat
behaviour seen in the theory. I'm afraid I don't have the time to test
these alternatives.

So, I'm sorry I don't really have anything particularly constructive to
say, but I thought it still worth mentioning what I think are weaknesses
in the scheme.

Thanks,
Simon Frankau.

 On Aug 26, 2007, at 1:42 PM, Thorkil Naur wrote:
 
  Hello,
 [snip]
  In the 2nd edition of Knuth's The Art of Computer Programming, Vol
  3, Sorting
  and Searching there is a discussion of hash functions on pp.  
  514-520. One of
  the techniques suggested for hashing a one-word (i.e. essentially  
  fixed-size)
  key is the following multiplicative scheme:
 
h(K) = floor ( M*(((A/w)*K)) mod 1) )
 
  where w is the word-size (say, 2^32), M is the desired limit of the
  hash
  function (for efficiency, probably a suitable power of 2) and,  
  finally, A is
  some integer constant. What happens here is that we consider the  
  (word) K as
  a fraction with the binary point at the left end of the word rather

  than at
  the right, thus getting a fraction with a value between 0 and 1.  
  This value
  we then multiply by A and cut off the integer part, once again  
  getting a
  fractional value between 0 and 1. And finally, we multiply by M and

  cut away
  the fractional part to get an integer value between 0 and M-1. And,

  sure,
  Knuth suggests various variants of selecting the multiplier A  
  related to the
  golden ratio (sqrt(5)-1)/2 = 0.6180... to gain suitable spreading  
  of hashes
  for keys in arithmetic progressions. (K, K+d, K+2d, ...).
 
 In the fix below I ended up using twice the golden ratio (a value of  
 A greater than one).  The inverse of the golden ratio (which is 1 +  
 golden) didn't work well at all.
 
  But what we are dealing with in the hashString function is what
  Knuth would
  call a multiword or variable-length key. Such cases, Knuth  
  suggests, can be
  handled by multiple-precision extensions of [e.g. the  
  multiplicative scheme]
  above, but it is generally adequate to speed things up by combining

  the
  individual words together into a single word, then doing a single
  multiplication ... as above.
 
 But combining things into a single word requires having a good  
 

Re: [GHC] #1198: readwrite002.exe: readwrite002.inout: hWaitForInput: invalid argument (Invalid argument)

2007-08-30 Thread GHC
#1198: readwrite002.exe: readwrite002.inout: hWaitForInput: invalid argument
(Invalid argument)
---+
Reporter:  igloo   |Owner:  simonmar
Type:  bug |   Status:  new 
Priority:  normal  |Milestone:  6.6.2   
   Component:  libraries/base  |  Version:  6.6 
Severity:  normal  |   Resolution:  
Keywords:  |   Difficulty:  Unknown 
  Os:  Windows | Testcase:  readwrite002
Architecture:  Unknown |  
---+
Changes (by simonmar):

  * owner:  = simonmar

Comment:

 I have a partial fix waiting for validation

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1198
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1283: thread-safe getStdRandom and newStdGen

2007-08-30 Thread GHC
#1283: thread-safe getStdRandom and newStdGen
--+-
Reporter:  [EMAIL PROTECTED]  |Owner:  simonmar   
Type:  bug|   Status:  new
Priority:  normal |Milestone:  6.6.2  
   Component:  libraries/base |  Version:  6.6
Severity:  normal |   Resolution: 
Keywords: |   Difficulty:  Easy (1 hr)
  Os:  Multiple   | Testcase: 
Architecture:  Multiple   |  
--+-
Changes (by simonmar):

  * owner:  = simonmar

Comment:

 I'm testing this one

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1283
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1616: segfault in generated file when using NOINLINE

2007-08-30 Thread GHC
#1616: segfault in generated file when using NOINLINE
-+--
Reporter:  guest |Owner: 
Type:  bug   |   Status:  closed 
Priority:  normal|Milestone:  6.8
   Component:  Compiler  |  Version:  6.6.1  
Severity:  normal|   Resolution:  fixed  
Keywords:|   Difficulty:  Unknown
  Os:  Linux | Testcase: 
Architecture:  x86   |  
-+--
Changes (by simonmar):

  * resolution:  = fixed
  * status:  new = closed

Comment:

 We concluded that GHC wasn't doing anything outside its contract, but that
 we should write down more clearly what the contract was, so I've tried to
 do that in the docs for `unsafeCoerce#`.

 If it wasn't clear earlier, the workaround for this bug is not to use
 Happy's -c option, but things should only go wrong currently if you are
 using -O and have parser productions that return functions.

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1616
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: Data.HashTable.hashInt seems somewhat sub-optimal

2007-08-30 Thread Ian Lynagh
On Wed, Aug 29, 2007 at 08:08:51PM -0400, Jan-Willem Maessen wrote:
 
 Recall that we're using the low-order bits of the hash code to index  
 into the table.

Aha, I see, thanks. OK, I'll push your patch after validating.


Thanks
Ian

___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1283: thread-safe getStdRandom and newStdGen

2007-08-30 Thread GHC
#1283: thread-safe getStdRandom and newStdGen
--+-
Reporter:  [EMAIL PROTECTED]  |Owner:  simonmar   
Type:  bug|   Status:  closed 
Priority:  normal |Milestone:  6.6.2  
   Component:  libraries/base |  Version:  6.6
Severity:  normal |   Resolution:  fixed  
Keywords: |   Difficulty:  Easy (1 hr)
  Os:  Multiple   | Testcase: 
Architecture:  Multiple   |  
--+-
Changes (by simonmar):

  * resolution:  = fixed
  * status:  new = closed

Comment:

 patch pushed and test added, thanks!

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1283
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1652: System.Directory.copyFile breakage

2007-08-30 Thread GHC
#1652: System.Directory.copyFile breakage
-+--
  Reporter:  sorear  |  Owner: 
  Type:  bug | Status:  new
  Priority:  normal  |  Milestone:  Not GHC
 Component:  libraries/base  |Version:  6.7
  Severity:  normal  |   Keywords: 
Difficulty:  Unknown | Os:  Linux  
  Testcase:  |   Architecture:  x86
-+--
Setup: /tmp, with one (executable) file 'x'.

 {{{
 [EMAIL PROTECTED]:/tmp$ rm *
 [EMAIL PROTECTED]:/tmp$  x
 [EMAIL PROTECTED]:/tmp$ chmod +x x
 }}}

 copyFile with relative paths does not work:

 {{{
 [EMAIL PROTECTED]:/tmp$ ghc -e 'System.Directory.copyFile x y'
 *** Exception: : copyFile: permission denied (Permission denied)
 }}}

 strace reveals an attempt to access /, possibly from a filepath mixup:

 {{{
 [EMAIL PROTECTED]:/tmp$ strace ghc -e 'System.Directory.copyFile x y'
 21 | grep EACCES
 open(/.copyFile.3550tmp,
 O_RDWR|O_CREAT|O_EXCL|O_NOCTTY|O_NONBLOCK|O_LARGEFILE, 0666) = -1 EACCES
 (Permission denied)
 }}}

 if absolute paths are used, the operation succeeds:

 {{{
 [EMAIL PROTECTED]:/tmp$ ghc -e 'System.Directory.copyFile /tmp/x /tmp/y'
 }}}

 ... but does not copy permissions.

 {{{
 [EMAIL PROTECTED]:/tmp$ ls -l
 total 0
 -rwxr-xr-x 1 stefan stefan 0 2007-08-30 09:37 x
 -rw-r--r-- 1 stefan stefan 0 2007-08-30 09:38 y
 }}}

 {{{
 [EMAIL PROTECTED]:/tmp$ ghc -V
 The Glorious Glasgow Haskell Compilation System, version 6.7.20070829
 }}}

 (NB: Cabal 'install' trips over this)

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1652
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


[GHC] #1653: GHCi ':set' completion does not list all options

2007-08-30 Thread GHC
#1653: GHCi ':set' completion does not list all options
--+-
  Reporter:  sorear   |  Owner:   
  Type:  bug  | Status:  new  
  Priority:  normal   |  Milestone:   
 Component:  GHCi |Version:  6.7  
  Severity:  normal   |   Keywords:   
Difficulty:  Unknown  | Os:  Linux
  Testcase:   |   Architecture:  x86  
--+-
In particular, the new -X options are missing:

 {{{
 [EMAIL PROTECTED]:/tmp$ ghci
 GHCi, version 6.7.20070829: http://www.haskell.org/ghc/  :? for help
 Loading package base ... linking ... done.
 Prelude :set -XTyp(TAB TAB, with no effect)
 unrecognised flags: -XTyp
 Prelude :set -XTypeFamilies
 Prelude Leaving GHCi.
 }}}

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1653
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


RE: Data.HashTable.hashInt seems somewhat sub-optimal

2007-08-30 Thread Simon.Frankau
Jan-Willem Maessen wrote:
[snip]
 [EMAIL PROTECTED] wrote:
  2) Signed multiplication is being used. I think unsigned
  multiplication
  is probably necessary to get the intended behaviour. For example,
with
  unsigned multiplication, multiplying by the original 'golden' and  
  taking
  the the top 32 bits is equivalent to multiplying by the golden
ratio,
  while with signed multiplication it is equivalent to multiplying by

  the
  golden ratio minus one.
 
 Actually, I've simply used the bits directly.  Signed twos-complement

 multiplication is the same as unsigned twos-complement multiplication

 (with all the unintuitive overflow behavior that entails).  viz:
 
   Numeric.showHex ((0x8001 :: Int32) * 2) 
 2
 
   Numeric.showHex ((0xa000 :: Int32) * 2) 
 4000

I was under the impression that sign extension means this is not the
case:

import Data.Int
import Data.Word
import Data.Bits

golden :: Int32
golden = -1640531527

mulHi :: Int32 - Int32 - Int32
mulHi a b = fromIntegral (r `shiftR` 32)
where r :: Int64
  r = fromIntegral a * fromIntegral b

golden' :: Word32
golden' = -1640531527

mulHi' :: Word32 - Word32 - Word32
mulHi' a b = fromIntegral (r `shiftR` 32)
where r :: Word64
  r = fromIntegral a * fromIntegral b

*Main :l /temp/test.hs
[1 of 1] Compiling Main ( /temp/test.hs, interpreted)
Ok, modules loaded: Main.
*Main mulHi golden 10
-38197
*Main mulHi' golden' 10
61803

(Given we're not using Knuth's algorithm, this is probably rather
academic, though.)

[snip]
  Why? People tend to hash lists with a fold
  which, for example, hashes the previous result, and then xors in or
  adds the new value.
 
 This is in general a rotten way to hash a list of things, which is  
 why presentations of hashing don't use it for hashing strings.   
 Interestingly Knuth does not cover this topic in detail and mentions  
 the use of addition or xor offhandedly.

Ok. My understanding of a sensible way to hash a list would be something
like this:

hashList = foldl' f base
where f m x = hashA x `op` hashB m

'op' is normally, say, addition. For the new hashString, hashA is the
low bits of a multiplication, and hashB is hashInt. Making hashB into
'id' is a really bad thing, since then you can commute items in a list
and get the same hash. Making hashA into 'id' seems less bad to me, at
least for non-nested lists (and looks like it is how the old hashString
worked). However, if hashB is your implementation of hashInt, hashA
needs to be good, otherwise hash collisions may result.

I think this is *really* non-obvious from the user's point of view.
Ideally the interface would expose two non-commuting hash functions to
make hashing tree-like structures better, but as you say, you're not
designing the interface from scratch, and so users have to work in a
framework where they are supplied with a single integer-hashing
function, and are implicitly required to implement another for all
non-trivial hashing work.

From the point of view of a user of a library, I think someone would
expect the built-in hash function to be robust. That is, something that
doesn't map small integers to small integers. If the user wants high
performance, they'll be writing custom hash functions based on
domain-specific knowledge. The library function should be there for
people who don't want to implement their own hashes.

[snip]
   * Put a rotation step in.
 
 Rotation, of course, just moves the problem elsewhere.

It does, but if you're gluing intermediate hash results together with an
addition, the problem goes away. It is rather usage-dependent,
admittedly, and thus probably not a good idea for a general-purpose,
library-exported hash function.

[snip]
 I agree that it's not without flaws (no cheap hash is, and the high- 
 order zeros are definitely a concern).  But I'll reiterate that I  
 believe it's pretty good *for the intended application* while  
 agreeing that *something better probably exists.*

I'm not sure that the intended usage pattern is obvious to me from the
documentation, but I'm willing to believe that's my problem rather than
yours. Certainly the changes you've made are an improvement on the
previous version. Given I'm not providing a viable alternative, it seems
best to commit your changes.

Thanks,
Simon Frankau.

For important statutory and regulatory disclosures and more information about 
Barclays Capital, please visit our web site at http://www.barcap.com.

Internet communications are not secure and therefore the Barclays Group does 
not accept legal responsibility for the contents of this message.  Although the 
Barclays Group operates anti-virus programmes, it does not accept 
responsibility for any damage whatsoever that is caused by viruses being 
passed.  Any views or opinions presented are solely those of the author and do 
not necessarily represent those of the Barclays 

Re: [GHC] #1226: Add flags --full-flag-help and --print-docdir

2007-08-30 Thread GHC
#1226: Add flags --full-flag-help and --print-docdir
+---
Reporter:  igloo|Owner:  igloo  
Type:  feature request  |   Status:  new
Priority:  high |Milestone:  6.8
   Component:  Driver   |  Version:  6.6
Severity:  normal   |   Resolution: 
Keywords:   |   Difficulty:  Unknown
  Os:  Unknown  | Testcase: 
Architecture:  Unknown  |  
+---
Changes (by igloo):

  * owner:  = igloo

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1226
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


Re: [GHC] #1625: Windows installer: no Users guide or Cabal docs

2007-08-30 Thread GHC
#1625: Windows installer: no Users guide or Cabal docs
-+--
Reporter:  simonmar  |Owner:  igloo  
Type:  bug   |   Status:  new
Priority:  high  |Milestone:  6.8
   Component:  Build System  |  Version:  6.6.1  
Severity:  normal|   Resolution: 
Keywords:|   Difficulty:  Unknown
  Os:  Windows   | Testcase: 
Architecture:  Unknown   |  
-+--
Changes (by igloo):

  * owner:  = igloo

-- 
Ticket URL: http://hackage.haskell.org/trac/ghc/ticket/1625
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler___
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs