{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Regex.Internal.Num
  ( mkNaturalDec
  , mkWordDecN
  , mkWordRangeDec
  , mkNaturalHex
  , mkWordHexN
  , mkWordRangeHex
  , mkSignedInteger
  , mkSignedIntRange
  ) where

#include "MachDeps.h"

import Control.Applicative
import Control.Monad
import Data.Primitive.PrimArray
import Data.Bits
import Numeric.Natural

import GHC.Num.Natural as Nat

import Regex.Internal.Regex (RE)
import qualified Regex.Internal.Regex as R

mkNaturalDec
  :: (Word -> Word -> RE c Word)  -- Decimal digit range
  -> RE c Natural
mkNaturalDec :: forall c. (Word -> Word -> RE c Word) -> RE c Natural
mkNaturalDec Word -> Word -> RE c Word
d =
      Natural
0 Natural -> RE c Word -> RE c Natural
forall a b. a -> RE c b -> RE c a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word -> Word -> RE c Word
d Word
0 Word
0
  RE c Natural -> RE c Natural -> RE c Natural
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word -> NatParseState -> Natural)
-> RE c Word -> RE c NatParseState -> RE c Natural
forall a b c. (a -> b -> c) -> RE c a -> RE c b -> RE c c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word -> NatParseState -> Natural
finishDec (Word -> Word -> RE c Word
d Word
1 Word
9) ((NatParseState -> Word -> NatParseState)
-> NatParseState -> RE c Word -> RE c NatParseState
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
R.foldlMany' NatParseState -> Word -> NatParseState
stepDec NatParseState
state0 (Word -> Word -> RE c Word
d Word
0 Word
9))
  where
    state0 :: NatParseState
state0 = Word -> Int -> WList -> NatParseState
NatParseState Word
0 Int
1 WList
WNil
    -- Start with len=1, it's reserved for the leading digit
{-# INLINE mkNaturalDec #-}

mkNaturalHex
  :: (Word -> Word -> RE c Word)  -- Hexadecimal digit range
  -> RE c Natural
mkNaturalHex :: forall c. (Word -> Word -> RE c Word) -> RE c Natural
mkNaturalHex Word -> Word -> RE c Word
d =
      Natural
0 Natural -> RE c Word -> RE c Natural
forall a b. a -> RE c b -> RE c a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word -> Word -> RE c Word
d Word
0 Word
0
  RE c Natural -> RE c Natural -> RE c Natural
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word -> NatParseState -> Natural)
-> RE c Word -> RE c NatParseState -> RE c Natural
forall a b c. (a -> b -> c) -> RE c a -> RE c b -> RE c c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Word -> NatParseState -> Natural
finishHex (Word -> Word -> RE c Word
d Word
1 Word
15) ((NatParseState -> Word -> NatParseState)
-> NatParseState -> RE c Word -> RE c NatParseState
forall b a c. (b -> a -> b) -> b -> RE c a -> RE c b
R.foldlMany' NatParseState -> Word -> NatParseState
stepHex NatParseState
state0 (Word -> Word -> RE c Word
d Word
0 Word
15))
  where
    state0 :: NatParseState
state0 = Word -> Int -> WList -> NatParseState
NatParseState Word
0 Int
1 WList
WNil
    -- Start with len=1, it's reserved for the leading digit
{-# INLINE mkNaturalHex #-}

mkSignedInteger :: RE c minus -> RE c plus -> RE c Natural -> RE c Integer
mkSignedInteger :: forall c minus plus.
RE c minus -> RE c plus -> RE c Natural -> RE c Integer
mkSignedInteger RE c minus
minus RE c plus
plus RE c Natural
rnat = RE c (Natural -> Integer)
signed RE c (Natural -> Integer) -> RE c Natural -> RE c Integer
forall a b. RE c (a -> b) -> RE c a -> RE c b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE c Natural
rnat
  where
    signed :: RE c (Natural -> Integer)
signed = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> (Natural -> Integer) -> Natural -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> RE c minus -> RE c (Natural -> Integer)
forall a b. a -> RE c b -> RE c a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE c minus
minus
         RE c (Natural -> Integer)
-> RE c (Natural -> Integer) -> RE c (Natural -> Integer)
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> RE c plus -> RE c (Natural -> Integer)
forall a b. a -> RE c b -> RE c a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RE c plus
plus
         RE c (Natural -> Integer)
-> RE c (Natural -> Integer) -> RE c (Natural -> Integer)
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Natural -> Integer) -> RE c (Natural -> Integer)
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

mkWordDecN
  :: (Word -> Word -> RE c Word)  -- Decimal digit range
  -> Int
  -> RE c Word
mkWordDecN :: forall c. (Word -> Word -> RE c Word) -> Int -> RE c Word
mkWordDecN Word -> Word -> RE c Word
d Int
n0
  | Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = RE c Word
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
  | Int
maxBoundWordDecLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n0 =
      Int -> RE c Word -> RE c ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxBoundWordDecLen) RE c Word
d00 RE c () -> RE c Word -> RE c Word
forall a b. RE c a -> RE c b -> RE c b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      (    RE c Word
d00 RE c Word -> RE c Word -> RE c Word
forall a b. RE c a -> RE c b -> RE c b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> RE c Word
forall {t}. (Eq t, Num t) => t -> RE c Word
go (Int
maxBoundWordDecLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word -> Word -> RE c Word) -> (Word, Word) -> RE c Word
forall c. (Word -> Word -> RE c Word) -> (Word, Word) -> RE c Word
mkWordRangeDec Word -> Word -> RE c Word
d (Int -> Word
pow10 Int
safeWordDecLen, Word
forall a. Bounded a => a
maxBound) )
  | Bool
otherwise = Int -> RE c Word
forall {t}. (Eq t, Num t) => t -> RE c Word
go Int
n0
  where
    go :: t -> RE c Word
go t
1 = RE c Word
d09
    go t
n = (Word -> Word -> Word) -> RE c Word -> RE c Word -> RE c Word
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
R.liftA2' (\Word
x Word
y -> Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
10 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
y) (t -> RE c Word
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)) RE c Word
d09
    d00 :: RE c Word
d00 = Word -> Word -> RE c Word
d Word
0 Word
0
    d09 :: RE c Word
d09 = Word -> Word -> RE c Word
d Word
0 Word
9
{-# INLINE mkWordDecN #-}

mkWordHexN
  :: (Word -> Word -> RE c Word)  -- Hexadecimal digit range
  -> Int
  -> RE c Word
mkWordHexN :: forall c. (Word -> Word -> RE c Word) -> Int -> RE c Word
mkWordHexN Word -> Word -> RE c Word
d Int
n0
  | Int
n0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = RE c Word
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
  | Int
maxBoundWordHexLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n0 =
      Int -> RE c Word -> RE c ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxBoundWordHexLen) RE c Word
d00 RE c () -> RE c Word -> RE c Word
forall a b. RE c a -> RE c b -> RE c b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> RE c Word
forall {t}. (Eq t, Num t) => t -> RE c Word
go Int
maxBoundWordHexLen
  | Bool
otherwise = Int -> RE c Word
forall {t}. (Eq t, Num t) => t -> RE c Word
go Int
n0
  where
    go :: t -> RE c Word
go t
1 = RE c Word
d0f
    go t
n = (Word -> Word -> Word) -> RE c Word -> RE c Word -> RE c Word
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
R.liftA2' (\Word
x Word
y -> Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
16 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
y) (t -> RE c Word
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)) RE c Word
d0f
    d00 :: RE c Word
d00 = Word -> Word -> RE c Word
d Word
0 Word
0
    d0f :: RE c Word
d0f = Word -> Word -> RE c Word
d Word
0 Word
15
{-# INLINE mkWordHexN #-}

mkWordRangeDec
  :: (Word -> Word -> RE c Word)  -- Decimal digit range
  -> (Word, Word)  -- Low high
  -> RE c Word
mkWordRangeDec :: forall c. (Word -> Word -> RE c Word) -> (Word, Word) -> RE c Word
mkWordRangeDec Word -> Word -> RE c Word
d (Word
l,Word
h) = Word
-> (Int -> Word -> (Word, Word))
-> (Int -> Word)
-> (Word -> Int)
-> (Word -> Word -> RE c Word)
-> Word
-> Word
-> RE c Word
forall c.
Word
-> (Int -> Word -> (Word, Word))
-> (Int -> Word)
-> (Word -> Int)
-> (Word -> Word -> RE c Word)
-> Word
-> Word
-> RE c Word
mkWordRangeBase Word
10 Int -> Word -> (Word, Word)
quotRemPow10 Int -> Word
pow10 Word -> Int
len10 Word -> Word -> RE c Word
d Word
l Word
h
  where
    quotRemPow10 :: Int -> Word -> (Word, Word)
quotRemPow10 Int
i Word
x = Word
x Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int -> Word
pow10 Int
i
{-# INLINE mkWordRangeDec #-}

mkWordRangeHex
  :: (Word -> Word -> RE c Word)  -- Hexadecimal digit range
  -> (Word, Word)  -- Low high
  -> RE c Word
mkWordRangeHex :: forall c. (Word -> Word -> RE c Word) -> (Word, Word) -> RE c Word
mkWordRangeHex Word -> Word -> RE c Word
d (Word
l,Word
h) = Word
-> (Int -> Word -> (Word, Word))
-> (Int -> Word)
-> (Word -> Int)
-> (Word -> Word -> RE c Word)
-> Word
-> Word
-> RE c Word
forall c.
Word
-> (Int -> Word -> (Word, Word))
-> (Int -> Word)
-> (Word -> Int)
-> (Word -> Word -> RE c Word)
-> Word
-> Word
-> RE c Word
mkWordRangeBase Word
16 Int -> Word -> (Word, Word)
quotRemPow16 Int -> Word
pow16 Word -> Int
len16 Word -> Word -> RE c Word
d Word
l Word
h
  where
    quotRemPow16 :: Int -> Word -> (Word, Word)
quotRemPow16 Int
i Word
x = (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i), Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Int -> Word
pow16 Int
i Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1))
{-# INLINE mkWordRangeHex #-}

mkSignedIntRange
  :: RE c minus
  -> RE c plus
  -> ((Word, Word) -> RE c Word)  -- Word range
  -> (Int, Int)  -- Low high
  -> RE c Int
mkSignedIntRange :: forall c minus plus.
RE c minus
-> RE c plus
-> ((Word, Word) -> RE c Word)
-> (Int, Int)
-> RE c Int
mkSignedIntRange RE c minus
minus RE c plus
plus (Word, Word) -> RE c Word
wordRangeDec (Int
low,Int
high) = case (Maybe (RE c Int)
negR, Maybe (RE c Int)
nonNegR) of
  (Maybe (RE c Int)
Nothing, Maybe (RE c Int)
Nothing) -> RE c Int
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
  (Maybe (RE c Int)
Nothing, Just RE c Int
r2) -> RE c Int
r2
  (Just RE c Int
r1, Maybe (RE c Int)
Nothing) -> RE c Int
r1
  (Just RE c Int
r1, Just RE c Int
r2) -> RE c Int
r1 RE c Int -> RE c Int -> RE c Int
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Int
r2
  where
    negR :: Maybe (RE c Int)
negR
      | Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Maybe (RE c Int)
forall a. Maybe a
Nothing
      | Bool
otherwise = RE c Int -> Maybe (RE c Int)
forall a. a -> Maybe a
Just (RE c Int -> Maybe (RE c Int)) -> RE c Int -> Maybe (RE c Int)
forall a b. (a -> b) -> a -> b
$
        RE c minus
minus RE c minus -> RE c Int -> RE c Int
forall a b. RE c a -> RE c b -> RE c b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        (Word -> Int) -> RE c Word -> RE c Int
forall a b c. (a -> b) -> RE c a -> RE c b
R.fmap' (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Word -> Int) -> Word -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                ((Word, Word) -> RE c Word
wordRangeDec (Int -> Word
absw (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
0 Int
high), Int -> Word
absw Int
low))
    nonNegR :: Maybe (RE c Int)
nonNegR
      | Int
high Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe (RE c Int)
forall a. Maybe a
Nothing
      | Bool
otherwise = RE c Int -> Maybe (RE c Int)
forall a. a -> Maybe a
Just (RE c Int -> Maybe (RE c Int)) -> RE c Int -> Maybe (RE c Int)
forall a b. (a -> b) -> a -> b
$
        (RE c plus -> RE c ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void RE c plus
plus RE c () -> RE c () -> RE c ()
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> RE c ()
forall a. a -> RE c a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) RE c () -> RE c Int -> RE c Int
forall a b. RE c a -> RE c b -> RE c b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        (Word -> Int) -> RE c Word -> RE c Int
forall a b c. (a -> b) -> RE c a -> RE c b
R.fmap' Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                ((Word, Word) -> RE c Word
wordRangeDec (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
low), Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
high))
{-# INLINE mkSignedIntRange #-}

absw :: Int -> Word
absw :: Int -> Word
absw = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (Int -> Int) -> Int -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs

-------------------
-- Parsing ranges
-------------------

-- Make a tree based on the range. Keep the tree size small where possible.
-- This is hard to explain in words, so see here for some pictures:
-- https://github.com/meooow25/parser-regex/wiki/Visualizations#int-range

mkWordRangeBase
  :: forall c.
     Word  -- Base
  -> (Int -> Word -> (Word, Word)) -- quotRemPowBase
  -> (Int -> Word)  -- powBase
  -> (Word -> Int)  -- baseLen
  -> (Word -> Word -> RE c Word)  -- Decimal digit range
  -> Word  -- Low
  -> Word  -- High
  -> RE c Word
mkWordRangeBase :: forall c.
Word
-> (Int -> Word -> (Word, Word))
-> (Int -> Word)
-> (Word -> Int)
-> (Word -> Word -> RE c Word)
-> Word
-> Word
-> RE c Word
mkWordRangeBase Word
_ Int -> Word -> (Word, Word)
_ Int -> Word
_ Word -> Int
_ Word -> Word -> RE c Word
_ Word
low Word
high | Word
low Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
high = RE c Word
forall a. RE c a
forall (f :: * -> *) a. Alternative f => f a
empty
mkWordRangeBase Word
base Int -> Word -> (Word, Word)
quotRemPowBase Int -> Word
powBase Word -> Int
baseLen Word -> Word -> RE c Word
d Word
low Word
high
  = Int -> Bool -> Word -> Word -> RE c Word
goTop (Word -> Int
baseLen Word
high Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
True Word
low Word
high
  where
    goTop :: Int -> Bool -> Word -> Word -> RE c Word
    goTop :: Int -> Bool -> Word -> Word -> RE c Word
goTop Int
0 Bool
_ Word
l Word
h = Word -> Word -> RE c Word
d Word
l Word
h
    goTop Int
i Bool
lz Word
l Word
h
      | Word
dl Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
dh       = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dh Word
dh (Int -> Bool -> Word -> Word -> RE c Word
goTop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
False Word
l' Word
h')
      | Bool
fullL Bool -> Bool -> Bool
&& Bool
fullH = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dl Word
dh (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
      | Bool
fullH          = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase (Word
dlWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1) Word
dh (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Word
reL
      | Bool
fullL          = RE c Word
reH RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dl (Word
dhWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
      | Word
dl Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
dh   = RE c Word
reH RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Word
reL
      | Bool
otherwise      = RE c Word
reH RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Word
reM RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Word
reL
      where
        pBase :: Word
pBase = Int -> Word
powBase Int
i
        (Word
dl,Word
l') = Int -> Word -> (Word, Word)
quotRemPowBase Int
i Word
l
        (Word
dh,Word
h') = Int -> Word -> (Word, Word)
quotRemPowBase Int
i Word
h
        lz' :: Bool
lz' = Bool
lz Bool -> Bool -> Bool
&& Word
dl Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
        fullL :: Bool
fullL = Bool -> Bool
not Bool
lz' Bool -> Bool -> Bool
&& Word
l' Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
        fullH :: Bool
fullH = Word
h' Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
pBase
        reL :: RE c Word
reL = if Bool
lz'
              then Int -> Bool -> Word -> RE c Word
goL (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
True Word
l'
              else Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dl Word
dl (Int -> Bool -> Word -> RE c Word
goL (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
False Word
l')
        reH :: RE c Word
reH = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dh Word
dh (Int -> Word -> RE c Word
goH (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Word
h')
        reM :: RE c Word
reM = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase (Word
dlWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1) (Word
dhWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

    goL :: Int -> Bool -> Word -> RE c Word
    goL :: Int -> Bool -> Word -> RE c Word
goL Int
0 Bool
_ Word
l = Word -> Word -> RE c Word
d Word
l (Word
baseWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)
    goL Int
i Bool
lz Word
l
      | Bool -> Bool
not Bool
lz Bool -> Bool -> Bool
&& Word
l Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Int -> RE c Word
goFull Int
i
      | Word
dl Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
baseWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1     = RE c Word
reL
      | Bool
otherwise        = RE c Word
reM RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Word
reL
      where
        pBase :: Word
pBase = Int -> Word
powBase Int
i
        (Word
dl,Word
l') = Int -> Word -> (Word, Word)
quotRemPowBase Int
i Word
l
        reL :: RE c Word
reL = if Bool
lz Bool -> Bool -> Bool
&& Word
dl Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
              then Int -> Bool -> Word -> RE c Word
goL (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
True Word
l'
              else Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dl Word
dl (Int -> Bool -> Word -> RE c Word
goL (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
False Word
l')
        reM :: RE c Word
reM = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase (Word
dlWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
1) (Word
baseWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

    goH :: Int -> Word -> RE c Word
    goH :: Int -> Word -> RE c Word
goH Int
0 Word
h = Word -> Word -> RE c Word
d Word
0 Word
h
    goH Int
i Word
h
      | Word
h Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
pBase Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
base = Int -> RE c Word
goFull Int
i
      | Word
dh Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0               = RE c Word
reH
      | Bool
otherwise             = RE c Word
reH RE c Word -> RE c Word -> RE c Word
forall a. RE c a -> RE c a -> RE c a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE c Word
reM
      where
        pBase :: Word
pBase = Int -> Word
powBase Int
i
        (Word
dh,Word
h') = Int -> Word -> (Word, Word)
quotRemPowBase Int
i Word
h
        reH :: RE c Word
reH = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
dh Word
dh (Int -> Word -> RE c Word
goH (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Word
h')
        reM :: RE c Word
reM = Word -> Word -> Word -> RE c Word -> RE c Word
leading Word
pBase Word
0 (Word
dhWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

    goFull :: Int -> RE c Word
    goFull :: Int -> RE c Word
goFull Int
0 = Word -> Word -> RE c Word
d Word
0 (Word
baseWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1)
    goFull Int
i = Word -> Word -> Word -> RE c Word -> RE c Word
leading (Int -> Word
powBase Int
i) Word
0 (Word
baseWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) (Int -> RE c Word
goFull (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

    leading :: Word -> Word -> Word -> RE c Word -> RE c Word
    leading :: Word -> Word -> Word -> RE c Word -> RE c Word
leading !Word
pBase Word
dl Word
dh = (Word -> Word -> Word) -> RE c Word -> RE c Word -> RE c Word
forall a1 a2 b c. (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
R.liftA2' (\Word
x Word
y -> Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
pBase Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
y) (Word -> Word -> RE c Word
d Word
dl Word
dh)
{-# INLINE mkWordRangeBase #-}

---------------------------------
-- Parsing hexadecimal Naturals
---------------------------------

-- Parsing hexadecimal is simple, there is no base conversion involved.
--
-- Step 1: Accumulate the hex digits, packed into Words
-- Step 2: Initialize a ByteArray and fill it with the Words
--
-- Because we create a Nat directly, this makes us depend on ghc-bignum and
-- GHC>=9.0.

stepHex :: NatParseState -> Word -> NatParseState
stepHex :: NatParseState -> Word -> NatParseState
stepHex (NatParseState Word
acc Int
len WList
ns) Word
d
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxBoundWordHexLen = Word -> Int -> WList -> NatParseState
NatParseState (Word
accWord -> Word -> Word
forall a. Num a => a -> a -> a
*Word
16 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
d) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) WList
ns
  | Bool
otherwise = Word -> Int -> WList -> NatParseState
NatParseState Word
d Int
1 (Word -> WList -> WList
WCons Word
acc WList
ns)

finishHex
  :: Word          -- ^ Leading digit
  -> NatParseState -- ^ Everything else
  -> Natural
finishHex :: Word -> NatParseState -> Natural
finishHex !Word
ld (NatParseState Word
acc0 Int
len0 WList
ns0) = case WList
ns0 of
  WList
WNil -> Word -> Natural
Nat.naturalFromWord (Word
ld Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
len0Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
acc0)
  WCons Word
n WList
ns1 ->
    let lns :: Int
lns = WList -> Int
lengthWList WList
ns1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        wsz :: Int
wsz = WORD_SIZE_IN_BITS
        !(PrimArray ByteArray#
byteArray) = (forall s. ST s (MutablePrimArray s Word)) -> PrimArray Word
forall a. (forall s. ST s (MutablePrimArray s a)) -> PrimArray a
runPrimArray ((forall s. ST s (MutablePrimArray s Word)) -> PrimArray Word)
-> (forall s. ST s (MutablePrimArray s Word)) -> PrimArray Word
forall a b. (a -> b) -> a -> b
$ do
          ma <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
lns
          if len0 == maxBoundWordHexLen
          then do
            let go Int
i Word
n1 WList
WNil = do
                  let n1' :: Word
n1' = Word
ld Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
maxBoundWordHexLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n1
                  MutablePrimArray (PrimState m) Word -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word
MutablePrimArray (PrimState m) Word
ma Int
i Word
n1'
                go Int
i Word
n1 (WCons Word
n2 WList
ns2) = do
                  MutablePrimArray (PrimState m) Word -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word
MutablePrimArray (PrimState m) Word
ma Int
i Word
n1
                  Int -> Word -> WList -> m ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word
n2 WList
ns2
            writePrimArray ma 0 acc0
            go 1 n ns1
          else do
            let go Int
i Word
prv Word
n1 WList
WNil = do
                  let n1' :: Word
n1' = Word
ld Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
maxBoundWordHexLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n1
                  MutablePrimArray (PrimState m) Word -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word
MutablePrimArray (PrimState m) Word
ma Int
i (Word
prv Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n1' Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
len0))
                  MutablePrimArray (PrimState m) Word -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word
MutablePrimArray (PrimState m) Word
ma (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Word
n1' Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wsz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
len0))
                go Int
i Word
prv Word
n1 (WCons Word
n2 WList
ns2) = do
                  MutablePrimArray (PrimState m) Word -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Word
MutablePrimArray (PrimState m) Word
ma Int
i (Word
prv Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
len0))
                  Int -> Word -> Word -> WList -> m ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Word
n1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wsz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
len0)) Word
n2 WList
ns2
            go 0 acc0 n ns1
          pure ma
    in ByteArray# -> Natural
Nat.NB ByteArray#
byteArray
-- finishHex does a bunch of unsafe stuff, so make sure things are correct:
-- * Bit shifts are in [0..wsz-1]
-- * Natural invariants:
--   * If the value fits in a word, it must be NS (via naturalFromWord here).
--   * Otherwise, use a ByteArray# with NB. The highest Word must not be 0.

-----------------------------
-- Parsing decimal Naturals
-----------------------------

-- The implementation below is adapted from the bytestring package.
-- https://github.com/haskell/bytestring/blob/7e11412b9bfb13bcd6b8e7c04765b8f5bd90fd34/Data/ByteString/Lazy/ReadNat.hs
--
-- Step 1: Accumulate the digits, packed into Words.
-- Step 2: Combine the packed Words bottom-up into the result. This is what
--         makes it better than foldl (\acc d -> acc * 10 + d)).
--
-- The obvious foldl approach is O(n^2) for n digits. The combine approach
-- performs O(n/2^i) multiplications of size O(2^i), for i in [0..log_2(n)].
-- If multiplication is O(n^k), this is also O(n^k). We have k < 2,
-- thanks to subquadratic multiplication of GMP-backed Naturals:
-- https://gmplib.org/manual/Multiplication-Algorithms.
--
-- For reference, here's how GMP converts any base (including 10) to a natural
-- using broadly the same approach.
-- https://github.com/alisw/GMP/blob/2bbd52703e5af82509773264bfbd20ff8464804f/mpn/generic/set_str.c

stepDec :: NatParseState -> Word -> NatParseState
stepDec :: NatParseState -> Word -> NatParseState
stepDec (NatParseState Word
acc Int
len WList
ns) Word
d
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
safeWordDecLen = Word -> Int -> WList -> NatParseState
NatParseState (Word
10Word -> Word -> Word
forall a. Num a => a -> a -> a
*Word
acc Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
d) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) WList
ns
  | Bool
otherwise = Word -> Int -> WList -> NatParseState
NatParseState Word
d Int
1 (Word -> WList -> WList
WCons Word
acc WList
ns)

finishDec
  :: Word          -- ^ Leading digit
  -> NatParseState -- ^ Everything else
  -> Natural
finishDec :: Word -> NatParseState -> Natural
finishDec !Word
ld (NatParseState Word
acc0 Int
len0 WList
ns0) = Word -> Int -> WList -> Natural
forall {b}. Integral b => Word -> b -> WList -> Natural
combine Word
acc0 Int
len0 WList
ns0
  where
    combine :: Word -> b -> WList -> Natural
combine !Word
acc !b
len WList
ns = case WList
ns of
      WList
WNil -> Word -> Natural
w2n (Word
10Word -> b -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^(b
lenb -> b -> b
forall a. Num a => a -> a -> a
-b
1) Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
ld Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
acc)
      WCons Word
n WList
ns1 -> Natural
10Natural -> b -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^b
len Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural -> [Natural] -> Natural
forall {t}. Num t => t -> [t] -> t
combine1 Natural
safeBaseDec (Word -> WList -> [Natural]
go Word
n WList
ns1) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Word -> Natural
w2n Word
acc
      where
        go :: Word -> WList -> [Natural]
go Word
n WList
WNil = let !n' :: Natural
n' = Word -> Natural
w2n (Word
highMulDec Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
ld Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n) in [Natural
n']
        go Word
n (WCons Word
m WList
WNil) =
          let !n' :: Natural
n' = Word -> Natural
w2n (Word
highMulDec Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
ld Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
m) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
safeBaseDec Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Word -> Natural
w2n Word
n in [Natural
n']
        go Word
n (WCons Word
m (WCons Word
n1 WList
ns1)) =
          let !n' :: Natural
n' = Word -> Natural
w2n Word
m Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
safeBaseDec Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Word -> Natural
w2n Word
n in Natural
n' Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: Word -> WList -> [Natural]
go Word
n1 WList
ns1

    combine1 :: t -> [t] -> t
combine1 t
_ [t
n] = t
n
    combine1 t
base [t]
ns1 = t -> [t] -> t
combine1 t
base1 ([t] -> [t]
go [t]
ns1)
      where
        !base1 :: t
base1 = t
base t -> t -> t
forall a. Num a => a -> a -> a
* t
base
        go :: [t] -> [t]
go (t
n:t
m:[t]
ns) = let !n' :: t
n' = t
m t -> t -> t
forall a. Num a => a -> a -> a
* t
base1 t -> t -> t
forall a. Num a => a -> a -> a
+ t
n in t
n' t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t] -> [t]
go [t]
ns
        go [t]
ns = [t]
ns

w2n :: Word -> Natural
w2n :: Word -> Natural
w2n = Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

safeBaseDec :: Natural
safeBaseDec :: Natural
safeBaseDec = Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word
pow10 Int
safeWordDecLen)

highMulDec :: Word
highMulDec :: Word
highMulDec = Int -> Word
pow10 (Int
safeWordDecLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

---------------------------
-- Common Natural parsing
---------------------------

data WList = WCons {-# UNPACK #-} !Word !WList | WNil

data NatParseState = NatParseState
  {-# UNPACK #-} !Word      -- ^ acc
  {-# UNPACK #-} !Int       -- ^ length of acc in some base
                 !WList     -- ^ accs, little endian

lengthWList :: WList -> Int
lengthWList :: WList -> Int
lengthWList = Int -> WList -> Int
forall {t}. Num t => t -> WList -> t
go Int
0
  where
    go :: t -> WList -> t
go !t
acc WList
WNil = t
acc
    go t
acc (WCons Word
_ WList
ns) = t -> WList -> t
go (t
acct -> t -> t
forall a. Num a => a -> a -> a
+t
1) WList
ns

--------------------
-- Low level stuff
--------------------

-- | Length in base 16.
len16 :: Word -> Int
len16 :: Word -> Int
len16 Word
0 = Int
1
len16 Word
x = Int
maxBoundWordHexLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Word -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)

-- | 16^i. i must not be large enough to overflow a Word.
pow16 :: Int -> Word
pow16 :: Int -> Word
pow16 Int
i = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)

-- | Length in base 10.
len10 :: Word -> Int
len10 :: Word -> Int
len10 Word
x = Word -> Int -> Int
forall {t}. Num t => Word -> t -> t
go Word
1 Int
1
  where
    x' :: Word
x' = Word
x Word -> Word -> Word
forall a. Integral a => a -> a -> a
`quot` Word
10
    go :: Word -> t -> t
go Word
p t
i | Word
x' Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
p = t
i
    go Word
p t
i = Word -> t -> t
go (Word
pWord -> Word -> Word
forall a. Num a => a -> a -> a
*Word
10) (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)

-- | "999..." repeated safeWordDecLen times is guaranteed to fit in a Word.
safeWordDecLen :: Int

-- | Decimal length of (maxBound :: Word)
maxBoundWordDecLen :: Int

-- | Hexadecimal length of (maxBound :: Word)
maxBoundWordHexLen :: Int

-- | 10^i. i must not be large enough to overflow a Word.
pow10 :: Int -> Word

#if WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64

#if WORD_SIZE_IN_BITS == 64
safeWordDecLen :: Int
safeWordDecLen = Int
19
maxBoundWordDecLen :: Int
maxBoundWordDecLen = Int
20
maxBoundWordHexLen :: Int
maxBoundWordHexLen = Int
16
#else
safeWordDecLen = 9
maxBoundWordDecLen = 10
maxBoundWordHexLen = 8
#endif

pow10 :: Int -> Word
pow10 Int
p = case Int
p of
  Int
0 -> Word
1
  Int
1 -> Word
10
  Int
2 -> Word
100
  Int
3 -> Word
1000
  Int
4 -> Word
10000
  Int
5 -> Word
100000
  Int
6 -> Word
1000000
  Int
7 -> Word
10000000
  Int
8 -> Word
100000000
  Int
9 -> Word
1000000000
#if WORD_SIZE_IN_BITS == 64
  Int
10 -> Word
10000000000
  Int
11 -> Word
100000000000
  Int
12 -> Word
1000000000000
  Int
13 -> Word
10000000000000
  Int
14 -> Word
100000000000000
  Int
15 -> Word
1000000000000000
  Int
16 -> Word
10000000000000000
  Int
17 -> Word
100000000000000000
  Int
18 -> Word
1000000000000000000
  Int
19 -> Word
10000000000000000000
#endif
  Int
_ -> [Char] -> Word
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Regex.Internal.Int.pow10: p too large"
#else
#error "unsupported word size"
#endif