On Mon, Jul 21, 2025 at 05:56:46PM +0200, Stefan Klinger wrote:

> >     - One way to avoid difficulties with handling negative minBound is
> >       to parse signed values via the corresponding unsigned type, which
> >       can accommodate `-minBound` as a positive value, and then negate
> >       the final result.  This makse possible sharing the low-level
> >       digit-by-digit code between the positive and negative cases.
> 
> How do you mean?  I did not get this “accommodate `-minBound` as a
> positive value” right, my initial approach to use
> 
>     char '-' >> negate <$> parseUnsigned (negate minBound)
> 
> fails, exactly because the negation of the lower bound may not be
> (read: is usually not) within the upper bound, and thus wraps around,
> e.g., incorrectly `negate (minBound :: Int8)` → `-128` due to the
> upper bound of `127`.

Timing is everything, you're trying to do the negation while the value
is still signed, instead it is necessary to convert it to a Natural while
also keeping track of the sign!

    {-# LANGUAGE RequiredTypeArguments #-}

    -- Ideally, compute both the sign and the absolute value in one go.

    minBoundAbs :: forall a -> (Bounded a, Integral a) => Natural
    minBoundAbs a = fromIntegral @Integer $ abs $ fromIntegral @a minBound

    maxBoundAbs :: forall a -> (Bounded a, Integral a) => Natural
    maxBoundAbs a = fromIntegral @Integer $ abs $ fromIntegral @a maxBound

    isNegative ::  forall a -> (Bounded a, Integral a) => a -> Bool
    isNegative x = fromIntegral @Integer x < 0

That said, the Bytestring code does not do that, rather it simply knows
that the absolute values of minBound and maxBound of the 8, 16, 32 and
64 bit signed integral types differ only in their last digit, and the
last digit of minBound is always 8, while for maxBound it is always 7.
For the unsigned types the last digit is always 5.

Since you're writing polymorphic parser code, rather than separate
logical functions for each of the fundamental integral types,  you'll
need to take the high road and compute the absolute value of each bound
as above while keeping track of its sign.  To handle arbitrary Bounded,
Integral types, the logic gets a bit more complex, because the upper
bound could also be negative, or the lower bound could be non-negative,
requiring some care in overflow safe:

    safeRead :: (Bounded a, Integral a) => String -> a
    safeReads :: (Bounded a, Integral a) => String -> [(a, String)]

-- 
    VIktor.
_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

Reply via email to