Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Clifford Beshers

Donald Bruce Stewart wrote:

I've always thought that the obfuscation opportunities for Num
literal overloading, combined with Num *overflowing* were
underappreciated.
  


Search for 'mel blackjack'.  You and Mel would get along fine.

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Albert Y. C. Lai

Donald Bruce Stewart wrote:

instance Num String anyone? Mwhaha
  

addString xs ys = add 0 xs ys
   where
 m = fromEnum (maxBound :: Char) + 1
 alu c x y =
 let s = c + fromEnum x + fromEnum y
 in if s >= m then (1, s-m) else (0, s)
 add c (x:xs) (y:ys) = case alu c x y of (c', s') -> toEnum s' : add c' xs 
ys
 add c [] (y:ys) = case alu c 0 y of (0, s') -> toEnum s' : ys
 (1, s') -> toEnum s' : add 1 [] ys
 add c xs@(_:_) [] = add c [] xs
 add c [] [] = if c==0 then [] else [toEnum c]


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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Paul Johnson
L.Guo wrote:
> Without thinking about for Word8, [1,18..256] is equal to [1,18..0]. Though
> I try to use "$!" to let GHC generate the list as Integer. It would not do so.
$! merely forces evaluation; it doesn't change the types.

What you want is more like:

ws: [Word8]
ws = map fromIntegral [1,18..256 :: Int]


There is no need for multi-precision Integers here: Int will do just fine.

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
ketil:
> On Fri, 2007-05-25 at 17:33 +1000, Donald Bruce Stewart wrote:
> 
> > Sorry, I should clarify, think about how to represent:
> > 
> > 256 :: Word8
> 
> So the error isn't really divide by zero, but overflow.  I've been
> bitten by this, too, and L.Guo should count him/herself lucky to get an
> error, and not just incorrect results.

I've always thought that the obfuscation opportunities for Num
literal overloading, combined with Num *overflowing* were
underappreciated.

instance Num String anyone? Mwhaha


-- Don

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Ketil Malde
On Fri, 2007-05-25 at 17:33 +1000, Donald Bruce Stewart wrote:

> Sorry, I should clarify, think about how to represent:
> 
> 256 :: Word8

So the error isn't really divide by zero, but overflow.  I've been
bitten by this, too, and L.Guo should count him/herself lucky to get an
error, and not just incorrect results.

IMO, this is a rather nasty hole in the safety nets that Haskell is so
abundantly endowed with.  Does any Haskell implementation support
overflow detection?

-k


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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread L.Guo
I think it likes a trap. See this.

Data.ByteString.unpack . Data.ByteString.pack $! ([0,17..255] ++ [1,18..256])

Without thinking about for Word8, [1,18..256] is equal to [1,18..0]. Though
I try to use "$!" to let GHC generate the list as Integer. It would not do so.

:-L

--   
L.Guo
2007-05-25

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread L.Guo
When I was tring manually truncate data to Word8 to fill into
ByteString, I got the exception.

Thanks. Now I understand the reason for that exception.
And I know it is no need to manually truncate data.

--   
L.Guo
2007-05-25

-
From: Donald Bruce Stewart
At: 2007-05-25 15:33:46
Subject: Re: [Haskell-cafe] Why this exception occurs ?

dons:
> leaveye.guo:
> > Hi.
> > 
> > In GHCi ver 6.6, why this happens ?
> > 
> > Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> > [0..511]
> > "*** Exception: divide by zero
> 
> It's the use of `rem` on Word8, by the way:
> 
> Prelude> (0 `rem` 256) :: Data.Word.Word8 
> *** Exception: divide by zero
> 

Sorry, I should clarify, think about how to represent:

256 :: Word8

;-)

-- Don

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
dons:
> leaveye.guo:
> > Hi.
> > 
> > In GHCi ver 6.6, why this happens ?
> > 
> > Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> > [0..511]
> > "*** Exception: divide by zero
> 
> It's the use of `rem` on Word8, by the way:
> 
> Prelude> (0 `rem` 256) :: Data.Word.Word8 
> *** Exception: divide by zero
> 

Sorry, I should clarify, think about how to represent:

256 :: Word8

;-)

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
leaveye.guo:
> Hi.
> 
> In GHCi ver 6.6, why this happens ?
> 
> Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> [0..511]
> "*** Exception: divide by zero

It's the use of `rem` on Word8, by the way:

Prelude> (0 `rem` 256) :: Data.Word.Word8 
*** Exception: divide by zero

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


Re: [Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread Donald Bruce Stewart
leaveye.guo:
> Hi.
> 
> In GHCi ver 6.6, why this happens ?
> 
> Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
> [0..511]
> "*** Exception: divide by zero

Interesting...

Is that just,
Data.ByteString.pack $ [0..255] ++ [0..255]
?

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


[Haskell-cafe] Why this exception occurs ?

2007-05-25 Thread L.Guo
Hi.

In GHCi ver 6.6, why this happens ?

Prelude Data.ByteString> Data.ByteString.pack $! Prelude.map (`rem` 256) $ 
[0..511]
"*** Exception: divide by zero

--
L.Guo
2007-05-25

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