[Haskell-cafe] parsing long numbers
Andrea Rossato
mailing_list at istitutocolli.org
Fri Sep 15 09:36:29 EDT 2006
Hello!
I'm trying to learn parsing and parser combinations in Haskell, using,
as usual, Wadler's Monads in Functional Programming as my text book.
Everything works fine except for a small but annoying problem related
to "read". I'm sure it must be something easy, some kind of stupid
faq. Still I'm not able to find a way out.
I created a simple parser and made it an instance of monad and
MonadPlus. I then created "iterateP" to combine recursive parsers, and
"filterP" to apply some filters.
Then I created a function "number", to parse numbers. This function
returns a string and works fine.
But I wanted to have integers back from parsing. So I created a
filter, "digitS", and a new parser for numbers, "number1", that applies
recursively digitS and should be returning an Int using "read".
The problem is that, when I run it with strings containing a number
more then 10 digit long, I get unexpected integers back:
*Main> runP number1 "1234567890 and the rest"
[(1234567890," and the rest")]
*Main> runP number1 "12345678901 and the rest"
[(-539222987," and the rest")]
Obviously if I use Parsec I can parse that number perfectly.
So I tried with another approach: "number2" recursively applies a
filter, "digitI", that returns an Int. asNumber is a function that
takes a list of single digit integers and returns the corresponding
integer.
*Main> runP number2 "12345678901 and the rest"
[(Just 1234567890," and the rest")]
*Main> runP number2 "12345678901 and the rest"
[(Just (-539222987)," and the rest")]
The very same result. Can you please help me understand why I seem not
to be able to get the number I'd like to get?
As I said, I think I'm missing something that must be pretty obvious,
but still I cannot see it!
Thanks for your kind attention.
Andrea
ps: sorry for such a long message.
Moreover, here's the code:
module Main where
import Control.Monad
import Data.Char
newtype M a = S {unpack :: String -> [(a,String)]}
instance Monad M where
return a = S $ \s -> [(a,s)]
m >>= f = S $ \s -> [(b,z) | (a,y) <- unpack m s, (b,z) <- unpack (f a) y]
instance MonadPlus M where
mzero = S $ \x -> []
mplus a b = a `bchoice` b
bchoice (S m) (S m1) = S $ \s -> case m s of
[] -> m1 s
other -> other
iterateP m = do { a <- m
; b <- iterateP m
; return (a:b)
}
`mplus` return []
filterP p = S (\xs -> case xs of
[] -> []
(x:xs') -> if p x then [(x,xs')] else [])
number = do { a <- filterP isDigit
; b <- number
; return (a:b)
}
`mplus` return []
digitS = do a <- filterP isDigit
return a
number1 :: M Int
number1 = do a <- iterateP digitS
return (read a)
-- a different approach
maybeAdd a b = do x <- a
y <- b
return (x + y)
asNumber :: [Int] -> Maybe Int
asNumber [] = Nothing
asNumber (x:[]) = Just x
asNumber (x:xs) = Just (x * 10 ^ length xs) `maybeAdd` asNumber xs
digitI = do a <- filterP isDigit
return $ ord a - ord '0'
number2 :: M (Maybe Int)
number2 = do a <- iterateP digitI
return $ asNumber a
runP (S f) = f
More information about the Haskell-Cafe
mailing list