{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoStrict #-}
{-# LANGUAGE TupleSections #-}
module Data.IP.Builder
(
ipBuilder
, ipv4Builder
, ipv6Builder
) where
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Prim as P
import Data.ByteString.Builder.Prim ((>$<), (>*<))
import GHC.Exts
import GHC.Word (Word8(..), Word16(..), Word32(..))
import Data.IP.Addr
{-# INLINE ipBuilder #-}
ipBuilder :: IP -> B.Builder
ipBuilder :: IP -> Builder
ipBuilder (IPv4 IPv4
addr) = IPv4 -> Builder
ipv4Builder IPv4
addr
ipBuilder (IPv6 IPv6
addr) = IPv6 -> Builder
ipv6Builder IPv6
addr
{-# INLINE ipv4Builder #-}
ipv4Builder :: IPv4 -> B.Builder
ipv4Builder :: IPv4 -> Builder
ipv4Builder IPv4
addr = BoundedPrim Word32 -> Word32 -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim Word32
ipv4Bounded (Word32 -> Builder) -> Word32 -> Builder
forall a b. (a -> b) -> a -> b
$! IPv4 -> Word32
fromIPv4w IPv4
addr
{-# INLINE ipv6Builder #-}
ipv6Builder :: IPv6 -> B.Builder
ipv6Builder :: IPv6 -> Builder
ipv6Builder IPv6
addr = BoundedPrim (Word32, Word32, Word32, Word32)
-> (Word32, Word32, Word32, Word32) -> Builder
forall a. BoundedPrim a -> a -> Builder
P.primBounded BoundedPrim (Word32, Word32, Word32, Word32)
ipv6Bounded ((Word32, Word32, Word32, Word32) -> Builder)
-> (Word32, Word32, Word32, Word32) -> Builder
forall a b. (a -> b) -> a -> b
$! IPv6 -> (Word32, Word32, Word32, Word32)
fromIPv6w IPv6
addr
toB :: P.FixedPrim a -> P.BoundedPrim a
toB :: FixedPrim a -> BoundedPrim a
toB = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
P.liftFixedToBounded
{-# INLINE toB #-}
ipv4Bounded :: P.BoundedPrim Word32
ipv4Bounded :: BoundedPrim Word32
ipv4Bounded =
Word32 -> (((Word8, ()), (Word8, ())), ((Word8, ()), Word8))
quads (Word32 -> (((Word8, ()), (Word8, ())), ((Word8, ()), Word8)))
-> BoundedPrim (((Word8, ()), (Word8, ())), ((Word8, ()), Word8))
-> BoundedPrim Word32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< ((BoundedPrim Word8
P.word8Dec BoundedPrim Word8 -> BoundedPrim () -> BoundedPrim (Word8, ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
dotsep) BoundedPrim (Word8, ())
-> BoundedPrim (Word8, ())
-> BoundedPrim ((Word8, ()), (Word8, ()))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< (BoundedPrim Word8
P.word8Dec BoundedPrim Word8 -> BoundedPrim () -> BoundedPrim (Word8, ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
dotsep))
BoundedPrim ((Word8, ()), (Word8, ()))
-> BoundedPrim ((Word8, ()), Word8)
-> BoundedPrim (((Word8, ()), (Word8, ())), ((Word8, ()), Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< ((BoundedPrim Word8
P.word8Dec BoundedPrim Word8 -> BoundedPrim () -> BoundedPrim (Word8, ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
dotsep) BoundedPrim (Word8, ())
-> BoundedPrim Word8 -> BoundedPrim ((Word8, ()), Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word8
P.word8Dec)
where
quads :: Word32 -> (((Word8, ()), (Word8, ())), ((Word8, ()), Word8))
quads Word32
a = ((Int# -> Word32 -> (Word8, ())
qdot Int#
0o30# Word32
a, Int# -> Word32 -> (Word8, ())
qdot Int#
0o20# Word32
a), (Int# -> Word32 -> (Word8, ())
qdot Int#
0o10# Word32
a, Word32 -> Word8
qfin Word32
a))
{-# INLINE quads #-}
qdot :: Int# -> Word32 -> (Word8, ())
qdot Int#
s (W32# Word#
a) = (Word# -> Word8
W8# (Word# -> Word#
wordToWord8Compat# ((Word# -> Word#
word32ToWordCompat# Word#
a Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
s) Word# -> Word# -> Word#
`and#` Word#
0xff##)), ())
{-# INLINE qdot #-}
qfin :: Word32 -> Word8
qfin (W32# Word#
a) = Word# -> Word8
W8# (Word# -> Word#
wordToWord8Compat# (Word# -> Word#
word32ToWordCompat# Word#
a Word# -> Word# -> Word#
`and#` Word#
0xff##))
{-# INLINE qfin #-}
dotsep :: BoundedPrim b
dotsep = Word8 -> b -> Word8
forall a b. a -> b -> a
const Word8
0x2e (b -> Word8) -> BoundedPrim Word8 -> BoundedPrim b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
toB FixedPrim Word8
P.word8
data FF = CHL Word32
| HL Word32
| NOP
| COL
| CC
| CLO Word32
| CHC Word32
| HC Word32
ipv6Bounded :: P.BoundedPrim (Word32, Word32, Word32, Word32)
ipv6Bounded :: BoundedPrim (Word32, Word32, Word32, Word32)
ipv6Bounded =
((Word32, Word32, Word32, Word32) -> Bool)
-> BoundedPrim (Word32, Word32, Word32, Word32)
-> BoundedPrim (Word32, Word32, Word32, Word32)
-> BoundedPrim (Word32, Word32, Word32, Word32)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (Word32, Word32, Word32, Word32) -> Bool
generalCase
( (Word32, Word32, Word32, Word32) -> ((FF, FF), (FF, FF))
genFields ((Word32, Word32, Word32, Word32) -> ((FF, FF), (FF, FF)))
-> BoundedPrim ((FF, FF), (FF, FF))
-> BoundedPrim (Word32, Word32, Word32, Word32)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim ((FF, FF), (FF, FF))
output128 )
( ((Word32, Word32, Word32, Word32) -> Bool)
-> BoundedPrim (Word32, Word32, Word32, Word32)
-> BoundedPrim (Word32, Word32, Word32, Word32)
-> BoundedPrim (Word32, Word32, Word32, Word32)
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (Word32, Word32, Word32, Word32) -> Bool
v4mapped
( (Word32, Word32, Word32, Word32)
-> ((Word32, Word32), (Word32, Word32))
forall a b a b. (a, b, a, b) -> ((a, b), (a, b))
pairPair ((Word32, Word32, Word32, Word32)
-> ((Word32, Word32), (Word32, Word32)))
-> BoundedPrim ((Word32, Word32), (Word32, Word32))
-> BoundedPrim (Word32, Word32, Word32, Word32)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Word32
forall b. BoundedPrim b
colsep BoundedPrim Word32
-> BoundedPrim Word32 -> BoundedPrim (Word32, Word32)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word32
forall b. BoundedPrim b
colsep)
BoundedPrim (Word32, Word32)
-> BoundedPrim (Word32, Word32)
-> BoundedPrim ((Word32, Word32), (Word32, Word32))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< (BoundedPrim Word32
forall b. BoundedPrim b
ffff BoundedPrim Word32
-> BoundedPrim Word32 -> BoundedPrim (Word32, Word32)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< (Word32 -> ((), Word32)
forall a. a -> ((), a)
fstUnit (Word32 -> ((), Word32))
-> BoundedPrim ((), Word32) -> BoundedPrim Word32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim () -> BoundedPrim Word32 -> BoundedPrim ((), Word32)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word32
ipv4Bounded)) )
( (Word32, Word32, Word32, Word32)
-> ((Word32, Word32), (Word32, Word32))
forall a b a b. (a, b, a, b) -> ((a, b), (a, b))
pairPair ((Word32, Word32, Word32, Word32)
-> ((Word32, Word32), (Word32, Word32)))
-> BoundedPrim ((Word32, Word32), (Word32, Word32))
-> BoundedPrim (Word32, Word32, Word32, Word32)
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim Word32
forall b. BoundedPrim b
P.emptyB BoundedPrim Word32
-> BoundedPrim Word32 -> BoundedPrim (Word32, Word32)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word32
forall b. BoundedPrim b
colsep) BoundedPrim (Word32, Word32)
-> BoundedPrim (Word32, Word32)
-> BoundedPrim ((Word32, Word32), (Word32, Word32))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< (BoundedPrim Word32
forall b. BoundedPrim b
colsep BoundedPrim Word32
-> BoundedPrim Word32 -> BoundedPrim (Word32, Word32)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word32
ipv4Bounded) ) )
where
{-# INLINE output128 #-}
{-# INLINE output64 #-}
{-# INLINE generalCase #-}
{-# INLINE v4mapped #-}
{-# INLINE output32 #-}
generalCase :: (Word32, Word32, Word32, Word32) -> Bool
generalCase :: (Word32, Word32, Word32, Word32) -> Bool
generalCase (Word32
w0, Word32
w1, Word32
w2, Word32
w3) =
Word32
w0 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
|| Word32
w1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
|| (Word32
w2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0xffff Bool -> Bool -> Bool
&& (Word32
w2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 Bool -> Bool -> Bool
|| Word32
w3 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0xffff))
v4mapped :: (Word32, Word32, Word32, Word32) -> Bool
v4mapped :: (Word32, Word32, Word32, Word32) -> Bool
v4mapped (Word32
w0, Word32
w1, Word32
w2, Word32
_) =
Word32
w0 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
w1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Word32
w2 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xffff
output128 :: P.BoundedPrim ((FF, FF), (FF, FF))
output128 :: BoundedPrim ((FF, FF), (FF, FF))
output128 = BoundedPrim (FF, FF)
output64 BoundedPrim (FF, FF)
-> BoundedPrim (FF, FF) -> BoundedPrim ((FF, FF), (FF, FF))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim (FF, FF)
output64
output64 :: BoundedPrim (FF, FF)
output64 = (BoundedPrim FF
output32 BoundedPrim FF -> BoundedPrim FF -> BoundedPrim (FF, FF)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim FF
output32)
output32 :: P.BoundedPrim FF
output32 :: BoundedPrim FF
output32 =
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { CHL Word32
_ -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
build_CHL (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { HL Word32
_ -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
build_HL (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { FF
NOP -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
forall b. BoundedPrim b
build_NOP (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { FF
COL -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
forall b. BoundedPrim b
build_COL (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { FF
CC -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
forall b. BoundedPrim b
build_CC (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { CLO Word32
_ -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
build_CLO (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
(FF -> Bool) -> BoundedPrim FF -> BoundedPrim FF -> BoundedPrim FF
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
P.condB (\case { CHC Word32
_ -> Bool
True; FF
_ -> Bool
False }) BoundedPrim FF
build_CHC (BoundedPrim FF -> BoundedPrim FF)
-> BoundedPrim FF -> BoundedPrim FF
forall a b. (a -> b) -> a -> b
$
BoundedPrim FF
build_HC
build_CHL :: BoundedPrim FF
build_CHL = ( \ case CHL Word32
w -> ( Word16 -> ((), Word16)
forall a. a -> ((), a)
fstUnit (Word32 -> Word16
hi16 Word32
w), Word16 -> ((), Word16)
forall a. a -> ((), a)
fstUnit (Word32 -> Word16
lo16 Word32
w) )
FF
_ -> (((), Word16), ((), Word16))
forall a. HasCallStack => a
undefined )
(FF -> (((), Word16), ((), Word16)))
-> BoundedPrim (((), Word16), ((), Word16)) -> BoundedPrim FF
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim () -> BoundedPrim Word16 -> BoundedPrim ((), Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word16
P.word16Hex)
BoundedPrim ((), Word16)
-> BoundedPrim ((), Word16)
-> BoundedPrim (((), Word16), ((), Word16))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< (BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim () -> BoundedPrim Word16 -> BoundedPrim ((), Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word16
P.word16Hex)
build_HL :: BoundedPrim FF
build_HL = ( \ case HL Word32
w -> ( Word32 -> Word16
hi16 Word32
w, Word16 -> ((), Word16)
forall a. a -> ((), a)
fstUnit (Word32 -> Word16
lo16 Word32
w) )
FF
_ -> (Word16, ((), Word16))
forall a. HasCallStack => a
undefined )
(FF -> (Word16, ((), Word16)))
-> BoundedPrim (Word16, ((), Word16)) -> BoundedPrim FF
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word16
P.word16Hex BoundedPrim Word16
-> BoundedPrim ((), Word16) -> BoundedPrim (Word16, ((), Word16))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim () -> BoundedPrim Word16 -> BoundedPrim ((), Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word16
P.word16Hex
build_NOP :: BoundedPrim a
build_NOP = BoundedPrim a
forall b. BoundedPrim b
P.emptyB
build_COL :: BoundedPrim b
build_COL = () -> b -> ()
forall a b. a -> b -> a
const () (b -> ()) -> BoundedPrim () -> BoundedPrim b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim ()
forall b. BoundedPrim b
colsep
build_CC :: BoundedPrim b
build_CC = ((), ()) -> b -> ((), ())
forall a b. a -> b -> a
const ((), ()) (b -> ((), ())) -> BoundedPrim ((), ()) -> BoundedPrim b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim () -> BoundedPrim () -> BoundedPrim ((), ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
colsep
build_CLO :: BoundedPrim FF
build_CLO = ( \ case CLO Word32
w -> Word16 -> ((), Word16)
forall a. a -> ((), a)
fstUnit (Word32 -> Word16
lo16 Word32
w)
FF
_ -> ((), Word16)
forall a. HasCallStack => a
undefined )
(FF -> ((), Word16)) -> BoundedPrim ((), Word16) -> BoundedPrim FF
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim () -> BoundedPrim Word16 -> BoundedPrim ((), Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word16
P.word16Hex
build_CHC :: BoundedPrim FF
build_CHC = ( \ case CHC Word32
w -> (Word16, ()) -> ((), (Word16, ()))
forall a. a -> ((), a)
fstUnit (Word16 -> (Word16, ())
forall a. a -> (a, ())
sndUnit (Word32 -> Word16
hi16 Word32
w))
FF
_ -> ((), (Word16, ()))
forall a. HasCallStack => a
undefined )
(FF -> ((), (Word16, ())))
-> BoundedPrim ((), (Word16, ())) -> BoundedPrim FF
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim ()
forall b. BoundedPrim b
colsep BoundedPrim ()
-> BoundedPrim (Word16, ()) -> BoundedPrim ((), (Word16, ()))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Word16
P.word16Hex BoundedPrim Word16 -> BoundedPrim () -> BoundedPrim (Word16, ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
colsep
build_HC :: BoundedPrim FF
build_HC = ( \ case HC Word32
w -> Word16 -> (Word16, ())
forall a. a -> (a, ())
sndUnit (Word32 -> Word16
hi16 Word32
w)
FF
_ -> (Word16, ())
forall a. HasCallStack => a
undefined )
(FF -> (Word16, ())) -> BoundedPrim (Word16, ()) -> BoundedPrim FF
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Word16
P.word16Hex BoundedPrim Word16 -> BoundedPrim () -> BoundedPrim (Word16, ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim ()
forall b. BoundedPrim b
colsep
colsep :: P.BoundedPrim a
colsep :: BoundedPrim a
colsep = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
toB (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ Word8 -> a -> Word8
forall a b. a -> b -> a
const Word8
0x3a (a -> Word8) -> FixedPrim Word8 -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word8
P.word8
ffff :: P.BoundedPrim a
ffff :: BoundedPrim a
ffff = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
toB (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ Word16 -> a -> Word16
forall a b. a -> b -> a
const Word16
0xffff (a -> Word16) -> FixedPrim Word16 -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Word16
P.word16HexFixed
hi16, lo16 :: Word32 -> Word16
hi16 :: Word32 -> Word16
hi16 !(W32# Word#
w) = Word# -> Word16
W16# (Word# -> Word#
wordToWord16Compat# (Word# -> Word#
word32ToWordCompat# Word#
w Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
16#))
lo16 :: Word32 -> Word16
lo16 !(W32# Word#
w) = Word# -> Word16
W16# (Word# -> Word#
wordToWord16Compat# (Word# -> Word#
word32ToWordCompat# Word#
w Word# -> Word# -> Word#
`and#` Word#
0xffff##))
fstUnit :: a -> ((), a)
fstUnit :: a -> ((), a)
fstUnit = ((), )
sndUnit :: a -> (a, ())
sndUnit :: a -> (a, ())
sndUnit = (, ())
pairPair :: (a, b, a, b) -> ((a, b), (a, b))
pairPair (a
a, b
b, a
c, b
d) = ((a
a, b
b), (a
c, b
d))
genFields :: (Word32, Word32, Word32, Word32) -> ((FF, FF), (FF, FF))
genFields (Word32
w0, Word32
w1, Word32
w2, Word32
w3) =
let !(!Int
gapStart, !Int
gapEnd) = Word32 -> Word32 -> Word32 -> Word32 -> (Int, Int)
bestgap Word32
w0 Word32
w1 Word32
w2 Word32
w3
!f0 :: FF
f0 = Int -> Int -> Word32 -> FF
makeF0 Int
gapStart Int
gapEnd Word32
w0
!f1 :: FF
f1 = Int -> Int -> Int# -> Int# -> Word32 -> FF
makeF12 Int
gapStart Int
gapEnd Int#
2# Int#
3# Word32
w1
!f2 :: FF
f2 = Int -> Int -> Int# -> Int# -> Word32 -> FF
makeF12 Int
gapStart Int
gapEnd Int#
4# Int#
5# Word32
w2
!f3 :: FF
f3 = Int -> Int -> Word32 -> FF
makeF3 Int
gapStart Int
gapEnd Word32
w3
in ((FF
f0, FF
f1), (FF
f2, FF
f3))
makeF0 :: Int -> Int -> Word32 -> FF
makeF0 (I# Int#
gapStart) (I# Int#
gapEnd) !Word32
w =
case (Int#
gapEnd Int# -> Int# -> Int#
==# Int#
0#) Int# -> Int# -> Int#
`orI#` (Int#
gapStart Int# -> Int# -> Int#
># Int#
1#) of
Int#
1# -> Word32 -> FF
HL Word32
w
Int#
_ -> case Int#
gapStart Int# -> Int# -> Int#
==# Int#
0# of
Int#
1# -> FF
COL
Int#
_ -> Word32 -> FF
HC Word32
w
{-# INLINE makeF0 #-}
makeF12 :: Int -> Int -> Int# -> Int# -> Word32 -> FF
makeF12 (I# Int#
gapStart) (I# Int#
gapEnd) Int#
il Int#
ir !Word32
w =
case (Int#
gapEnd Int# -> Int# -> Int#
<=# Int#
il) Int# -> Int# -> Int#
`orI#` (Int#
gapStart Int# -> Int# -> Int#
># Int#
ir) of
Int#
1# -> Word32 -> FF
CHL Word32
w
Int#
_ -> case Int#
gapStart Int# -> Int# -> Int#
>=# Int#
il of
Int#
1# -> case Int#
gapStart Int# -> Int# -> Int#
==# Int#
il of
Int#
1# -> FF
COL
Int#
_ -> Word32 -> FF
CHC Word32
w
Int#
_ -> case Int#
gapEnd Int# -> Int# -> Int#
==# Int#
ir of
Int#
0# -> FF
NOP
Int#
_ -> Word32 -> FF
CLO Word32
w
{-# INLINE makeF12 #-}
makeF3 :: Int -> Int -> Word32 -> FF
makeF3 (I# Int#
gapStart) (I# Int#
gapEnd) !Word32
w =
case Int#
gapEnd Int# -> Int# -> Int#
<=# Int#
6# of
Int#
1# -> Word32 -> FF
CHL Word32
w
Int#
_ -> case Int#
gapStart Int# -> Int# -> Int#
==# Int#
6# of
Int#
0# -> case Int#
gapEnd Int# -> Int# -> Int#
==# Int#
8# of
Int#
1# -> FF
COL
Int#
_ -> Word32 -> FF
CLO Word32
w
Int#
_ -> FF
CC
{-# INLINE makeF3 #-}
bestgap :: Word32 -> Word32 -> Word32 -> Word32 -> (Int, Int)
bestgap :: Word32 -> Word32 -> Word32 -> Word32 -> (Int, Int)
bestgap !(W32# Word#
a0) !(W32# Word#
a1) !(W32# Word#
a2) !(W32# Word#
a3) =
Int# -> (Int, Int)
finalGap
(Word# -> Int# -> Int#
updateGap (Word#
0xffff## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a3))
(Word# -> Int# -> Int#
updateGap (Word#
0xffff0000## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a3))
(Word# -> Int# -> Int#
updateGap (Word#
0xffff## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a2))
(Word# -> Int# -> Int#
updateGap (Word#
0xffff0000## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a2))
(Word# -> Int# -> Int#
updateGap (Word#
0xffff## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a1))
(Word# -> Int# -> Int#
updateGap (Word#
0xffff0000## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a1))
(Word# -> Int# -> Int#
updateGap (Word#
0xffff## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a0))
(Word# -> Int#
initGap (Word#
0xffff0000## Word# -> Word# -> Word#
`and#` (Word# -> Word#
word32ToWordCompat# Word#
a0))))))))))
where
initGap :: Word# -> Int#
initGap :: Word# -> Int#
initGap Word#
w = case Word#
w of { Word#
0## -> Int#
0x1717#; Word#
_ -> Int#
0x0707# }
updateGap :: Word# -> Int# -> Int#
updateGap :: Word# -> Int# -> Int#
updateGap Word#
w Int#
g = case Word#
w Word# -> Word# -> Int#
`neWord#` Word#
0## of
Int#
1# -> (Int#
g Int# -> Int# -> Int#
+# Int#
0xffff#) Int# -> Int# -> Int#
`andI#` Int#
0xff0f#
Int#
_ -> let old :: Int#
old = Int#
g Int# -> Int# -> Int#
+# Int#
0xf#
zi :: Int#
zi = Int#
old Int# -> Int# -> Int#
`andI#` Int#
0xff#
new :: Int#
new = (Int#
zi Int# -> Int# -> Int#
`uncheckedIShiftL#` Int#
8#) Int# -> Int# -> Int#
`orI#` Int#
zi
in case Int#
new Int# -> Int# -> Int#
># Int#
old of
Int#
1# -> Int#
new
Int#
_ -> Int#
old
finalGap :: Int# -> (Int, Int)
finalGap :: Int# -> (Int, Int)
finalGap Int#
i =
let g :: Int#
g = Int#
i Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
12#
in case Int#
g Int# -> Int# -> Int#
<# Int#
2# of
Int#
1# -> (Int
0, Int
0)
Int#
_ -> let e :: Int#
e = Int#
8# Int# -> Int# -> Int#
-# ((Int#
i Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
8#) Int# -> Int# -> Int#
`andI#` Int#
0xf#)
s :: Int#
s = Int#
e Int# -> Int# -> Int#
-# Int#
g
in (Int# -> Int
I# Int#
s, Int# -> Int
I# Int#
e)
{-# INLINE bestgap #-}
#if MIN_VERSION_base(4,16,0)
word32ToWordCompat# :: Word32# -> Word#
word32ToWordCompat# = word32ToWord#
wordToWord8Compat# :: Word# -> Word8#
wordToWord8Compat# = wordToWord8#
wordToWord16Compat# :: Word# -> Word16#
wordToWord16Compat# = wordToWord16#
#else
word32ToWordCompat# :: Word# -> Word#
word32ToWordCompat# :: Word# -> Word#
word32ToWordCompat# Word#
x = Word#
x
wordToWord8Compat# :: Word# -> Word#
wordToWord8Compat# :: Word# -> Word#
wordToWord8Compat# Word#
x = Word#
x
wordToWord16Compat# :: Word# -> Word#
wordToWord16Compat# :: Word# -> Word#
wordToWord16Compat# Word#
x = Word#
x
#endif