[Haskell-cafe] A bug of groupBy implement

2009-12-07 Thread L.Guo
Hi there:

My friend asked me a question, and i suppose he has found a bug of `groupBy'.

Here is the code piece:

> List.groupBy (\a b -> Foreign.unsafePerformIO (Text.Printf.printf "\t%d <= %d 
> ?: %s\n" a b (show (a<=b)) >> return (a<=b))) [7,3,5,9,6,8,3,5,4]

I have tested it in GHC 6.10.4 (Win XP) and GHC 6.8.3 (Linux), both give the 
wrong result (categaried):

7 <= 3 ?: False
3 <= 5 ?: True
3 <= 9 ?: True
3 <= 6 ?: True
3 <= 8 ?: True
3 <= 3 ?: True
3 <= 5 ?: True
3 <= 4 ?: True
[[7],[3,5,9,6,8,3,5,4]]


Regards
--
L.Guo
2009-12-08

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


[Haskell-cafe] A mistake in haskellwiki

2009-08-05 Thread L.Guo
Hi haskellers:

There is a mistake in http://www.haskell.org/haskellwiki/State_Monad

It post two functions like this :

  evalState :: State s a -> s -> a
  evalState act = fst $ runState act

  execState :: State s a -> s -> s
  execState act = snd $ runState act

Both the '$' operators should be '.'.

Anyone would correct it ?

Regards
--
L.Guo
2009-08-06

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


[Haskell-cafe] A new haskell tools project

2009-03-15 Thread L.Guo
Hi all:

I have just created an haskell work toolset project in google code.

Currently there are only a few tools to process YUV image files I wrote 
before.

Welcome you attend in to improve my code or to add in your tools.
And also pleasure to get your advices.

http://code.google.com/p/haskellworkingtools/

Regards
--
L.Guo
2009-03-16

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


[Haskell-cafe] Re: Why 'round' does not just round numbers ?

2008-10-27 Thread L.Guo
Thank you all for instructions.

I am not the same education route with you, so i just heard round-to-even for 
the very first time.

Now I understand why it exists in theory.

And then, in haskell, is that means, I have to use 'floor . (.5+)' instead of 
'round' to get the common round function ?

Or else, is there any other alter-round-function in haskell to do this ?

--   
L.Guo
2008-10-27


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


[Haskell-cafe] Why 'round' does not just round numbers ?

2008-10-27 Thread L.Guo
Hi all:


I just read about definitions of Prelude [1], and noticing that.

In 6.4.6 Coercions and Component Extraction, it discribes like this:


"round x returns the nearest integer to x, the even integer if x is equidistant 
between two integers."


I think this is unresonable. then try it in GHC 6.8.3.


Prelude> round 3.5
4
Prelude> round 2.5
2


Is there any explanation about that ?


[1] The Haskell 98 Report: Predefined Types and Classes
http://haskell.org/onlinereport/basic.html

Regards
--
L.Guo
2008-10-27

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


Re: [Haskell-cafe] Multi-line string literals are both easy /and/elegant in Haskell

2008-10-13 Thread L.Guo
Oh, that's so cool.

But, this feather is too difficult to be configured in UE32 -- my costom IDE.

Pity. Hopes I wouldn't forget it later.

--   
L.Guo
2008-10-14

-
From: Matt Morrow
At: 2008-10-14 02:15:30
Subject: [Haskell-cafe] Multi-line string literals are both easy /and/elegant 
in Haskell

The new QuasiQuotes extension arriving with ghc 6.10 is very exciting,
and handling multi-line string literals is like stealing candy from
a baby. ;)

-
-- Here.hs
module Here (here) where

import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lib

here :: QuasiQuoter
here = QuasiQuoter (litE . stringL) (litP . stringL)
-

-
-- There.hs
{-# LANGUAGE QuasiQuotes #-}
module Main where
import Here (here)
main = putStr [$here|

Shall I say, I have gone at dusk through narrow streets
And watched the smoke that rises from the pipes
Of lonely men in shirt-sleeves, leaning out of windows?

I should have been a pair of ragged claws
Scuttling across the floors of silent seas.


|]
-

-
[EMAIL PROTECTED] a]$ ghc -O2 --make There.hs
[1 of 2] Compiling Here ( Here.hs, Here.o )
[2 of 2] Compiling Main ( There.hs, There.o )
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
Loading package syb ... linking ... done.
Loading package array-0.2.0.0 ... linking ... done.
Loading package packedstring-0.1.0.1 ... linking ... done.
Loading package containers-0.2.0.0 ... linking ... done.
Loading package pretty-1.0.1.0 ... linking ... done.
Loading package template-haskell ... linking ... done.
Linking There ...
[EMAIL PROTECTED] a]$ ./There


Shall I say, I have gone at dusk through narrow streets
And watched the smoke that rises from the pipes
Of lonely men in shirt-sleeves, leaning out of windows?

I should have been a pair of ragged claws
Scuttling across the floors of silent seas.


[EMAIL PROTECTED] a]$
-
___
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] Hoogle often updates ?

2008-07-07 Thread L.Guo
Hi Haskellers:

I have just been asked for usage of timer in haskell. Which I did not
remember clearly. So I ask the search engine.

In Hoogle: timer
In Google: haskell timer

After I tried these, I wonder, when and how often the hoogle update its
database? And, could hoogle search range cover the hackages?

I like hoogle engine. Bcuz it is a very usful tool which helps me learn
haskell. Wish it better.

Regards
--
L.Guo
2008-07-08

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


Re: [Haskell-cafe] Re: Haskell on ARM (was Re: ANN: Topkata)

2008-07-02 Thread L.Guo
Thanks for sharing your experences.

I just tried to port GHC 6.8.3 to my TI Davincci (c6446) board by
following the GHC Wiki Building/Porting page [1]. Both arm-compile
and cross-compile version have failed unfortunately.

So, I turn to try compile an local GHC on linux.
It takes me so many time.
I can not finish building it before off work.

[1] 
http://hackage.haskell.org/trac/ghc/wiki/Building/Porting#PortingGHCtoanewplatform

--   
L.Guo
2008-07-02

-
From: Jeremy Shaw
At: 2008-06-28 02:57:38
Subject: Re: [Haskell-cafe] Re: Haskell on ARM (was Re: ANN: Topkata)

Cool!

By cross-compilation, I assume you mean, a version of GHC which runs
on x86, but generates ARM assembly? Another option might be to use a
nintendo DS emulator which has been configured to support more RAM and
CPU power ?

A true cross-compiler would be nice though, because it will run much
faster. GHC does have some support for cross-compilation, but in the
current implementation, it is mostly (entirely?) there for
bootstrapping. I have no idea how the ghc backend rewrite for 6.10
will affect this.

Hope this helps,
j.
___
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] How does GHC read UNICODE.

2008-05-19 Thread L.Guo
Hi Haskellers:

I am a Chinese.

Mostly, it is needed to read/write UNICODE charactors.

Currently, I can only use the ByteString module in GHC 6, 2007.
But I feel it is not an easy method.

Does GHC support it now ? or, is there any other way to do this ?

Regards
--
L.Guo
2008-05-20

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


[Haskell-cafe] How to organize code

2008-01-27 Thread L.Guo
Hi,

How do you organize code ?

Here is a sample.
Acturally, I am thinking about using this plan.

Any suggestions ?

> -- BasicalType.hs
> type Position = (Int,Int)
> data Box = Box { pos :: Position }
> data Chain = Chain { pos :: [Position] }

> -- Object.hs
> import BasicalType
> class Object o where
>   pos :: o -> [Position]

> -- Type.hs
> import BasicalType
> import Object
> instance Object Box where
>   pos = return . BasicalType.pos
> instance Object Chain where
>   pos = BasicalType.pos

> -- Main.hs
> import Type
> ...

Regards
--
L.Guo
2008-01-28

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


Re: [Haskell-cafe] How to convert number types.

2007-12-31 Thread L.Guo
Ah, thanks, it is my fault, for mis-understanding the hint from GHC.

And what is the difference between fromIntegral and fromInteger ?

--   
L.Guo
2008-01-01

-
From: Mark T.B. Carroll
At: 2008-01-01 01:42:37
Subject: Re: [Haskell-cafe] How to convert number types.

Perhaps fromIntegral does what you want?

Mark

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


[Haskell-cafe] How to convert number types.

2007-12-31 Thread L.Guo
Hi MailList Haskell-Cafe:

I am a new haskeller. And was farmilar with C.

When tring to do some calculate, like this:

input = 5 :: Int
factor = 1.20 :: Float
output = factor ** (toFloat input)

I found that I do not know any function could do just what 'toFloat'
should do.

What should I do then ?

Regards
--
L.Guo
2008-01-01

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


[Haskell-cafe] Cross-compiling of GHC

2007-09-17 Thread L.Guo
Hi all:

How to build a GHC which can run in a embed linux system ?

I have toolchain for the targer system. Using which, I can
compile on PC and run the program on the embed system.

Is this means, if I change CC env-var to the toolchain compiler
and compile GHC manually, I can get a program for the embed 
system ?

I have read Building/Porting for GHC[1], that does not mention
anything about how to build a GHC on a target machine using a
cross-compiler like xxx-linux-gcc.
*or*
What do I need to do besides the stages that page mentioned ?

Regards

[1] http://hackage.haskell.org/trac/ghc/wiki/Building/Porting

--
L.Guo
2007-09-17

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


Re: [Haskell-cafe] Memory leak or wrong use of Array ?

2007-09-14 Thread L.Guo
Hi Stuart.

Thanks for your advice about thunk, though I do not understand *thunk*
very well. Is there any other discriptions about thunk ?

I have tried the *seq* operation. When input is 10,000,000, the memory
still "leak", and there is still a "stack overflow".

I changed some mapM_ to sequence . map f, and tried to save some division.

The key functions now looks like this:

  proportions n = unsafePerformIO $ do
  arr <- newArray (2,n) (False,1/1) :: Fractional t => IO (IOArray Int 
(Bool,t))
  sequence_ $ map (sieve arr n) [2..n]
  factors <- getElems arr
  return . map (\(n,(b,f)) -> (f,n)) $ zip [2..n] factors
where
  sieve arr ubound p = do
  (b,o) <- readArray arr p
  if b then return () else
sequence_ . map (update arr (toRational p)) . takeWhile (<=ubound) 
$ iterate (+p) p
  update arr p i = do
  (_,o) <- readArray arr i
  --writeArray arr i (True,o*(p-1)/p)
  let val = o * p / (p-1)
  val `seq` return () -- force the thunk
  writeArray arr i (True, val)
  solutionOf = snd . minimum
 . filter (\(f,n) -> isPerm (floor $ toRational n/f) n) . 
proportions

------   
L.Guo
2007-09-15


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


[Haskell-cafe] Memory leak or wrong use of Array ?

2007-09-13 Thread L.Guo
Hi MailList Haskell-Cafe:

I am tring to solve Project Euler problem 70.
And write some code. (will at the end of this mail)
And, I run the code in GHCi.

The problem is that, when the input is 1,000,000, it works 
fine, when the input is up to 10,000,000, the memory GHCi 
used increase very fast and did not stop.

Is this a memory leak ? or, is there some mis-understand 
about array ?

Regards
--
-- Mudules :
import Data.Array.IO
import Foreign ( unsafePerformIO )
-- Codes :
p070_solve = putStrLn . show $ solutionOf 1000
  where
isPerm a b = sort (show a) == sort (show b)
phis n = unsafePerformIO $ do
arr <- newArray (2,n) (False,1/1) :: Fractional t => IO (IOArray Int 
(Bool,t))
mapM_ (sieve arr n) [2..n]
factors <- getElems arr
return . map (\(n,(b,f)) -> (n,floor $ toRational n*f)) $ zip [2..n] 
factors
  where
sieve arr ubound p = do
(b,o) <- readArray arr p
if b then return () else
  mapM_ (update arr (toRational p)) . takeWhile (<=ubound) $ 
iterate (+p) p
update arr p i = do
(_,o) <- readArray arr i
writeArray arr i (True,o*(p-1)/p)
solutionOf = snd . minimum
   . map (\(n,phi)->(toRational n / toRational phi,n))
   . filter (uncurry isPerm) . phis
--
L.Guo
2007-09-14

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


Re: [Haskell-cafe] Hints for Euler Problem 11

2007-08-17 Thread L.Guo
Hi.

My plan is just add some *unusable* data to make diagonal grid normally.

Here this is.

p011_input = input ++ (transpose input) ++ diagInput ++ diagInputT
  where diagInput = p011_toDiag input
diagInputT = p011_toDiag . (map reverse) $ input
input = [ [08,02,22,97,38,15,00,40,00,75,04,05,07,78,52,12,50,77,91,08],
  [49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,04,56,62,00],
  ... ,
  [01,70,54,71,83,51,54,69,16,92,33,48,61,43,52,01,89,19,67,48] 
]
p011_toDiag = (map remove) . transpose . (map append) . addIndex
  where addIndex = zip [0..]
append (n,y) = replicate n (-1) ++ y ++ replicate (19-n) (-1)
remove = filter (-1/=)
p011_toGroups x = case x of
  (a:b:c:d:xs)  -> [a,b,c,d] : p011_toGroups (b:c:d:xs)
  _ -> []
p011_solve = putStrLn . show $ (foldl1 max) . (map product) . concat . (map 
p011_toGroups) $ p011_input


--   
L.Guo
2007-08-17

-
From: Ronald Guida
At: 2007-07-20 11:39:50
Subject: [Haskell-cafe] Hints for Euler Problem 11

To handle the diagonals, my plan is to try to extract each diagonal as
a list of elements and put all the diagonals into a list; then I can
use maxHorizontal.

I came up with this function to try to extract the main diagonal.

 > getDiag :: [[a]] -> [a]
 > getDiag = map (head . head) . iterate (tail . map tail)

The problem is, this function doesn't work unless I have an infinite
grid.


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


Re: [Haskell-cafe] A few questions on primes generating.

2007-08-13 Thread L.Guo
Because 10,000,000 is too large for a Int, it is always in type of Integer or 
some higher level data type.

--   
L.Guo
2007-08-13

-
From: Alexis Hazell
At: 2007-08-13 22:46:46
Subject: Re: [Haskell-cafe] A few questions on primes generating.

On Tuesday 14 August 2007 00:22, L.Guo wrote:

> 2) We have this type definition :
> pureSieve :: Int -> Int
>Why there is no error (type mismatch) of this call in func main :
> pureSieve 1000

The Haskell Report says that an Int covers at least the range [- 2^29, 2^29 - 
1], which that number is well within . . . . why do you think it should 
report a type error? 


Alexis.
___
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] A few questions on primes generating.

2007-08-13 Thread L.Guo
Hi All:

I am reading http://www.haskell.org/haskellwiki/Prime_numbers

The code in sector "1 Bitwise prime sieve".

I have 3 questions about it.

1) In function go, what does the number 46340 mean ? Is it sqrt(MAX_LONG) ?
2) We have this type definition :
pureSieve :: Int -> Int
   Why there is no error (type mismatch) of this call in func main :
pureSieve 1000
3) In main again, what does expression [| x |] mean ? Why this cannot be 
execute in GHCi ?

Thanks for any advice.

Regards
------
L.Guo
2007-08-13

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


Re: [Haskell-cafe] Haskell's "currying" versus Business Objects GemCutter's "burning"

2007-07-03 Thread L.Guo
In this case, I usually use _flip_ function.

flip :: (a -> b -> c) -> b -> a -> c
flip f x y = f y x

--   
L.Guo
2007-07-04

-
From: peterv
At: 2007-07-03 17:40:35
Subject: [Haskell-cafe] Haskell's "currying" versus Business Objects 
GemCutter's "burning"

In Haskell, currying can only be done on the last (rightmost) function 
arguments.


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


Re: [Haskell-cafe] How to devide matrix into small blocks

2007-06-14 Thread L.Guo
Hi Janis.


I think either my data format or my original question confuses you.


About the problem description.

When I send the question, I have not decide how to manage the block data.
If the rough question confuse you, I have to say sorry.


About the data.

The whole image is of type [[a]], and after being devided, it is also [[a]].

eg.

for (w,h) = (2,2)

a b c d
e f g h
i j k l
m n o p

makes

a b e f
c d g h
i j m n
k l o p

in another word, mkBlocks makes [pixels-of-lines] into [pixels-in-blocks].

This cryptical type is easy to form and to form from type 
[[pixels-of-lines-in-block]], and also, is close to my future purpose.


Thanks.

--   
L.Guo
2007-06-14

-
From: Janis Voigtlaender
At: 2007-06-14 15:42:40
Subject: Re: [Haskell-cafe] How to devide matrix into small blocks

L.Guo wrote:
> I have wrote the target function like this, and tested.
> 
> mkBlocks (w,h) = map concat . concat . transpose . chop h . map (chop w)

I don't understand how this relates to your original problem
description. But then, again, I probably did not understand that one too
well.

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


Re: [Haskell-cafe] How to devide matrix into small blocks

2007-06-13 Thread L.Guo
Hi, Henning Thielemann.

Thanks for your help. That is usful.

I have wrote the target function like this, and tested.

mkBlocks (w,h) = map concat . concat . transpose . chop h . map (chop w)


Hi, Dr. Janis Voigtlaender.

This is not a homework, though likely to be one.

I just use Haskell to write tools being used in my work. This is one of them.

I need to locate the difference between my coded image and standard coded image.
And both coded in 16x16 macroblocks. That is why I ran into this problem.

Anyway, thanks for your advice.

--   
L.Guo
2007-06-14


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


[Haskell-cafe] How to devide matrix into small blocks

2007-06-12 Thread L.Guo
Hi all:

I already have one matrix of type [[a]] to store one image.

What I want to do is to devide the image into severial small blocks in same 
size.

To do that, I wrote this tool function.

chop  :: Int -> [a] -> [[a]]
chop _ [] = []
chop n ls = take n ls : chop n (drop n ls)

But I do not know how to use it to write the function.

Thanks for any advice.

Regards
--
L.Guo
2007-06-13

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


[Haskell-cafe] Which regular syntax does Text.Regex use?

2007-06-10 Thread L.Guo
Hi All:

I wrote this func :

  match = matchRegex . mkRegex

And when using it, I found that I have not even know the syntax of Regex.

Eager for your hint.

Regards
--
L.Guo
2007-06-11

___
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


[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


Re: Re: [Haskell-cafe] (no subject)

2007-05-24 Thread L.Guo
Very thanks for your example, I have not notice that there is a group of
hGetxxx functions in ByteString. In other words, I was using hGetxxx which
implemented in IO module. So it always failed.



--   
L.Guo
2007-05-24

-
From: Donald Bruce Stewart
At: 2007-05-24 17:31:02
Subject: Re: Re: [Haskell-cafe] (no subject)

I mean, what problem are you trying to solve? Ptrs aren't the usual way
to manipulate files in Haskell.

...

-- Don

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


Re: Re: [Haskell-cafe] (no subject)

2007-05-24 Thread L.Guo
To read the handle openBinaryFile returns, both the hGetBuf and
hGetBufNonBlocking needs one parameter _buf_ of type Ptr a.
I can not get one data of that type.

In the doc, there is only nullPtr, and also some type cast functions.
I failed to find some other buffer-maker function.

What should I do ?

--   
L.Guo
2007-05-24

-
From: Donald Bruce Stewart
At: 2007-05-24 17:03:55
Subject: Re: Re: [Haskell-cafe] (no subject)

What are you trying to do?

-- Don

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


Re: Re: [Haskell-cafe] (no subject)

2007-05-24 Thread L.Guo
to Ketil :

Tring openBinaryFile, I notice that I cannot make one usable buffer,
just because I can not find one function to "malloc" a memory or just
get one "change-able" buffer.

:-$


to Marc:

I can not locate which module including readBinaryFile.
And I use hoogle search engine.



Could you give me some more hints ?

--   
L.Guo
2007-05-24

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


Re: [Haskell-cafe] (no subject)

2007-05-24 Thread L.Guo
Sorry for not familiar to the email client.

My system is WinXP, and using GHC 6.6.
And is read from file.
Data is truncated at the ^Z char.

I just wrote one simple test code.

> import IO
> 
> writeTest fn = do
>   h <- openFile fn WriteMode
>   mapM_ (\p -> hPutChar h (toEnum p::Char)) $ [0..255] ++ [0..255]
>   hClose h
> 
> accessTest fn = do
>   h <- openFile fn ReadMode
>   s <- hGetContents h
>   putStrLn . show . map fromEnum $ s
>   hClose h
> 
> main = do
>   writeTest "ttt"
>   accessTest "ttt"


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


Re: [Haskell-cafe] (no subject)

2007-05-23 Thread L.Guo
Thanks for your suggestion, and sorry for the subject.

I have read the introduction of Data.ByteString, it is helpful.

And also, there is one problem left. When i read a binary file, data is 
truncated at the charactor EOF.

Which function could do this work correctly ?

--   
L.Guo
2007-05-24

-
发件人:Donald Bruce Stewart
发送日期:2007-05-24 14:03:27
收件人:L.Guo
抄送:MailList Haskell-Cafe
主题:Re: [Haskell-cafe] (no subject)

leaveye.guo:
> Hi MailList Haskell-Cafe:
> 
> Till now, which module / package / lib can i use to access binary
> file ? And is this easy to use in GHC ?

Data.Binary? Or perhaps just Data.ByteString, available on hackage,

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary-0.3

or in base.

-- Don


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


[Haskell-cafe] (no subject)

2007-05-23 Thread L.Guo
Hi MailList Haskell-Cafe:

Till now, which module / package / lib can i use to access binary file ? 
And is this easy to use in GHC ?

Regards
--
L.Guo
2007-05-24

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