packages feed

basement-cd (empty) → 0.0.12.1

raw patch · 92 files changed

+18525/−0 lines, 92 filesdep +Win32dep +basedep +ghc-primsetup-changed

Dependencies added: Win32, base, ghc-prim

Files

+ Basement/Alg/Class.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE MultiParamTypeClasses      #-}++module Basement.Alg.Class+    ( Indexable, index+    , RandomAccess, read, write+    ) where++import           Basement.Types.OffsetSize++class Indexable container ty where+    index :: container -> (Offset ty) -> ty++class RandomAccess container prim ty where+    read  :: container -> (Offset ty)       -> prim ty+    write :: container -> (Offset ty) -> ty -> prim ()
+ Basement/Alg/Mutable.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Basement.Alg.Mutable+    ( inplaceSortBy+    ) where++import           GHC.Types+import           GHC.Prim+import           Basement.Compat.Base+import           Basement.Numerical.Additive+import           Basement.Numerical.Multiplicative+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.Monad+import           Basement.Alg.Class++inplaceSortBy :: (PrimMonad prim, RandomAccess container prim ty) +              => (ty -> ty -> Ordering)+              -- ^ Function defining the ordering relationship+              -> (Offset ty) -- ^ Offset to first element to sort+              -> (CountOf ty) -- ^ Number of elements to sort+              -> container -- ^ Data to be sorted+              -> prim ()+inplaceSortBy ford start len mvec+    = qsort start (start `offsetPlusE` len `offsetSub` 1)+    where+        qsort lo hi+            | lo >= hi  = pure ()+            | otherwise = do+                p <- partition lo hi+                qsort lo (pred p)+                qsort (p+1) hi+        pivotStrategy (Offset low) hi@(Offset high) = do+            let mid = Offset $ (low + high) `div` 2+            pivot <- read mvec mid+            read mvec hi >>= write mvec mid+            write mvec hi pivot -- move pivot @ pivotpos := hi+            pure pivot+        partition lo hi = do+            pivot <- pivotStrategy lo hi+            -- RETURN: index of pivot with [<pivot | pivot | >=pivot]+            -- INVARIANT: i & j are valid array indices; pivotpos==hi+            let go i j = do+                    -- INVARIANT: k <= pivotpos+                    let fw k = do ak <- read mvec k+                                  if ford ak pivot == LT +                                    then fw (k+1)+                                    else pure (k, ak)+                    (i, ai) <- fw i -- POST: ai >= pivot+                    -- INVARIANT: k >= i+                    let bw k | k==i = pure (i, ai)+                             | otherwise = do ak <- read mvec k+                                              if ford ak pivot /= LT+                                                then bw (pred k)+                                                else pure (k, ak)+                    (j, aj) <- bw j -- POST: i==j OR (aj<pivot AND j<pivotpos)+                    -- POST: ai>=pivot AND (i==j OR aj<pivot AND (j<pivotpos))+                    if i < j+                        then do -- (ai>=p AND aj<p) AND (i<j<pivotpos)+                            -- swap two non-pivot elements and proceed+                            write mvec i aj+                            write mvec j ai+                            -- POST: (ai < pivot <= aj)+                            go (i+1) (pred j)+                        else do -- ai >= pivot +                            -- complete partitioning by swapping pivot to the center+                            write mvec hi ai +                            write mvec i pivot+                            pure i+            go lo hi+{-# INLINE inplaceSortBy #-}
+ Basement/Alg/PrimArray.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE MagicHash                  #-}+module Basement.Alg.PrimArray+    ( Indexable, index+    , findIndexElem+    , revFindIndexElem+    , findIndexPredicate+    , revFindIndexPredicate+    , foldl+    , foldr+    , foldl1+    , all+    , any+    , filter+    ) where++import           GHC.Types+import           GHC.Prim+import           Basement.Alg.Class+import           Basement.Compat.Base+import           Basement.Numerical.Additive+import           Basement.Numerical.Multiplicative+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.Monad++findIndexElem :: (Indexable container ty, Eq ty) => ty -> container -> Offset ty -> Offset ty -> Offset ty+findIndexElem ty ba startIndex endIndex = loop startIndex+  where+    loop !i+        | i >= endIndex    = sentinel+        | index ba i == ty = i+        | otherwise        = loop (i+1)+{-# INLINE findIndexElem #-}++revFindIndexElem :: (Indexable container ty, Eq ty) => ty -> container -> Offset ty -> Offset ty -> Offset ty+revFindIndexElem ty ba startIndex endIndex = loop endIndex+  where+    loop !iplus1+        | iplus1 <= startIndex = sentinel+        | index ba i == ty     = i+        | otherwise            = loop i+      where !i = iplus1 `offsetMinusE` 1+{-# INLINE revFindIndexElem #-}++findIndexPredicate :: Indexable container ty => (ty -> Bool) -> container -> Offset ty -> Offset ty -> Offset ty+findIndexPredicate predicate ba startIndex endIndex = loop startIndex+  where+    loop !i+        | i >= endIndex          = sentinel+        | predicate (index ba i) = i+        | otherwise              = loop (i+1)+{-# INLINE findIndexPredicate #-}++revFindIndexPredicate :: Indexable container ty => (ty -> Bool) -> container -> Offset ty -> Offset ty -> Offset ty+revFindIndexPredicate predicate ba startIndex endIndex = loop endIndex+  where+    loop !iplus1+        | iplus1 <= startIndex   = sentinel+        | predicate (index ba i) = i+        | otherwise              = loop i+      where !i = iplus1 `offsetMinusE` 1+{-# INLINE revFindIndexPredicate #-}++foldl :: Indexable container ty => (a -> ty -> a) -> a -> container -> Offset ty -> Offset ty -> a+foldl f !initialAcc ba !startIndex !endIndex = loop startIndex initialAcc+  where+    loop !i !acc+        | i == endIndex = acc+        | otherwise     = loop (i+1) (f acc (index ba i))+{-# INLINE foldl #-}++foldr :: Indexable container ty => (ty -> a -> a) -> a -> container -> Offset ty -> Offset ty -> a+foldr f !initialAcc ba startIndex endIndex = loop startIndex+  where+    loop !i+        | i == endIndex = initialAcc+        | otherwise     = index ba i `f` loop (i+1)+{-# INLINE foldr #-}++foldl1 :: Indexable container ty => (ty -> ty -> ty) -> container -> Offset ty -> Offset ty -> ty+foldl1 f ba startIndex endIndex = loop (startIndex+1) (index ba startIndex)+  where+    loop !i !acc+        | i == endIndex = acc+        | otherwise     = loop (i+1) (f acc (index ba i))+{-# INLINE foldl1 #-}++filter :: (PrimMonad prim, PrimType ty, Indexable container ty)+       => (ty -> Bool) -> MutableByteArray# (PrimState prim) +       -> container -> Offset ty -> Offset ty -> prim (CountOf ty)+filter predicate dst src start end = loop azero start+  where+    loop !d !s+        | s == end    = pure (offsetAsSize d)+        | predicate v = primMbaWrite dst d v >> loop (d+Offset 1) (s+Offset 1)+        | otherwise   = loop d (s+Offset 1)+      where+        v = index src s+{-# INLINE filter #-}++all :: Indexable container ty => (ty -> Bool) -> container -> Offset ty -> Offset ty -> Bool+all predicate ba start end = loop start+  where+    loop !i+        | i == end               = True+        | predicate (index ba i) = loop (i+1)+        | otherwise              = False+{-# INLINE all #-}++any :: Indexable container ty => (ty -> Bool) -> container -> Offset ty -> Offset ty -> Bool+any predicate ba start end = loop start+  where+    loop !i+        | i == end               = False+        | predicate (index ba i) = True+        | otherwise              = loop (i+1)+{-# INLINE any #-}
+ Basement/Alg/String.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE CPP                        #-}+module Basement.Alg.String+    ( copyFilter+    , validate+    , findIndexPredicate+    , revFindIndexPredicate+    ) where++import           GHC.Prim+import           GHC.ST+import           Basement.Alg.Class+import           Basement.Alg.UTF8+import           Basement.Compat.Base+import           Basement.Numerical.Additive+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.Block (MutableBlock(..))++import           Basement.UTF8.Helper+import           Basement.UTF8.Table+import           Basement.UTF8.Types++copyFilter :: forall s container . Indexable container Word8+           => (Char -> Bool)+           -> CountOf Word8+           -> MutableByteArray# s+           -> container+           -> Offset Word8+           -> ST s (CountOf Word8)+copyFilter predicate !sz dst src start = loop (Offset 0) start+  where+    !end = start `offsetPlusE` sz+    loop !d !s+        | s == end  = pure (offsetAsSize d)+        | otherwise =+            let !h = nextAscii src s+             in case headerIsAscii h of+                    True | predicate (toChar1 h) -> primMbaWrite dst d (stepAsciiRawValue h) >> loop (d + Offset 1) (s + Offset 1)+                         | otherwise             -> loop d (s + Offset 1)+                    False ->+                        case next src s of+                            Step c s' | predicate c -> writeUTF8 (MutableBlock dst :: MutableBlock Word8 s) d c >>= \d' -> loop d' s'+                                      | otherwise   -> loop d s'+{-# INLINE copyFilter #-}++validate :: Indexable container Word8+         => Offset Word8+         -> container+         -> Offset Word8+         -> (Offset Word8, Maybe ValidationFailure)+validate end ba ofsStart = loop4 ofsStart+  where+    loop4 !ofs+        | ofs4 < end =+            let h1 = nextAscii ba ofs+                h2 = nextAscii ba (ofs+1)+                h3 = nextAscii ba (ofs+2)+                h4 = nextAscii ba (ofs+3)+             in if headerIsAscii h1 && headerIsAscii h2 && headerIsAscii h3 && headerIsAscii h4+                    then loop4 ofs4+                    else loop ofs+        | otherwise     = loop ofs+      where+        !ofs4 = ofs+4+    loop !ofs+        | ofs == end      = (end, Nothing)+        | headerIsAscii h = loop (ofs + Offset 1)+        | otherwise       = multi (CountOf $ getNbBytes h) ofs+      where+        h = nextAscii ba ofs++    multi (CountOf 0xff) pos = (pos, Just InvalidHeader)+    multi nbConts pos+        | (posNext `offsetPlusE` nbConts) > end = (pos, Just MissingByte)+        | otherwise =+            case nbConts of+                CountOf 1 ->+                    let c1 = index ba posNext+                    in if isContinuation c1+                        then loop (pos + Offset 2)+                        else (pos, Just InvalidContinuation)+                CountOf 2 ->+                    let c1 = index ba posNext+                        c2 = index ba (pos + Offset 2)+                     in if isContinuation2 c1 c2+                            then loop (pos + Offset 3)+                            else (pos, Just InvalidContinuation)+                CountOf _ ->+                    let c1 = index ba posNext+                        c2 = index ba (pos + Offset 2)+                        c3 = index ba (pos + Offset 3)+                     in if isContinuation3 c1 c2 c3+                            then loop (pos + Offset 4)+                            else (pos, Just InvalidContinuation)+      where posNext = pos + Offset 1+{-# INLINE validate #-}++findIndexPredicate :: Indexable container Word8+                   => (Char -> Bool)+                   -> container+                   -> Offset Word8+                   -> Offset Word8+                   -> Offset Word8+findIndexPredicate predicate ba !startIndex !endIndex = loop startIndex+  where+    loop !i+        | i < endIndex && not (predicate c) = loop (i')+        | otherwise                         = i+      where+        Step c i' = next ba i+{-# INLINE findIndexPredicate #-}++revFindIndexPredicate :: Indexable container Word8+                      => (Char -> Bool)+                      -> container+                      -> Offset Word8+                      -> Offset Word8+                      -> Offset Word8+revFindIndexPredicate predicate ba startIndex endIndex+    | endIndex > startIndex = loop endIndex+    | otherwise             = endIndex+  where+    loop !i+        | predicate c     = i'+        | i' > startIndex = loop i'+        | otherwise       = endIndex+      where +        StepBack c i' = prev ba i+{-# INLINE revFindIndexPredicate #-}
+ Basement/Alg/UTF8.hs view
@@ -0,0 +1,293 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE CPP                        #-}+module Basement.Alg.UTF8+    ( nextAscii+    , nextAsciiDigit+    , expectAscii+    , next+    , nextSkip+    , nextWith+    , prev+    , prevSkip+    , writeASCII+    , writeUTF8+    , toList+    , all+    , any+    , foldr+    , length+    , reverse+    ) where++import           GHC.Types+import           GHC.Word+import           GHC.Prim+import           Data.Bits+import           Data.Proxy+import           Basement.Alg.Class+import           Basement.Compat.Base hiding (toList)+import           Basement.Compat.Primitive+import           Basement.Monad+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.Types.OffsetSize+import           Basement.Types.Char7 (Char7(..))+import           Basement.PrimType+import           Basement.UTF8.Helper+import           Basement.UTF8.Table+import           Basement.UTF8.Types+import           Basement.HeadHackageUtils++nextAscii :: Indexable container Word8 => container -> Offset Word8 -> StepASCII+nextAscii ba n = StepASCII w+  where+    !w = index ba n+{-# INLINE nextAscii #-}++-- | nextAsciiBa specialized to get a digit between 0 and 9 (included)+nextAsciiDigit :: Indexable container Word8 => container -> Offset Word8 -> StepDigit+nextAsciiDigit ba n = StepDigit (index ba n - 0x30)+{-# INLINE nextAsciiDigit #-}++expectAscii :: Indexable container Word8 => container -> Offset Word8 -> Word8 -> Bool+expectAscii ba n v = index ba n == v+{-# INLINE expectAscii #-}++next :: Indexable container Word8 => container -> Offset8 -> Step+next ba n =+    case getNbBytes h of+        0 -> Step (toChar1 h) (n + Offset 1)+        1 -> Step (toChar2 h (index ba (n + Offset 1))) (n + Offset 2)+        2 -> Step (toChar3 h (index ba (n + Offset 1))+                             (index ba (n + Offset 2))) (n + Offset 3)+        3 -> Step (toChar4 h (index ba (n + Offset 1))+                             (index ba (n + Offset 2))+                             (index ba (n + Offset 3))) (n + Offset 4)+        r -> error ("next: internal error: invalid input: offset=" <> show n <> " table=" <> show r <> " h=" <> show (stepAsciiRawValue h))+  where+    !h = nextAscii ba n+{-# INLINE next #-}++nextSkip :: Indexable container Word8 => container -> Offset Word8 -> Offset Word8+nextSkip ba n = n + 1 + Offset (getNbBytes (nextAscii ba n))+{-# INLINE nextSkip #-}++-- | special case for only non ascii next'er function+nextWith :: Indexable container Word8+         => StepASCII+         -> container+         -> Offset8+         -> Step+nextWith h ba n =+    case getNbBytes h of+        1 -> Step (toChar2 h (index ba n)) (n + Offset 1)+        2 -> Step (toChar3 h (index ba n) (index ba (n + Offset 1))) (n + Offset 2)+        3 -> Step (toChar4 h (index ba n)+                             (index ba (n + Offset 1))+                             (index ba (n + Offset 2))) (n + Offset 3)+        r -> error ("nextWith: internal error: invalid input: offset=" <> show n <> " table=" <> show r <> " h=" <> show (stepAsciiRawValue h))+{-# INLINE nextWith #-}++-- Given a non null offset, give the previous character and the offset of this character+-- will fail bad if apply at the beginning of string or an empty string.+prev :: Indexable container Word8 => container -> Offset Word8 -> StepBack+prev ba offset =+    case index ba prevOfs1 of+        (W8# v1) | isContinuation# (word8ToWordCompat# v1) -> atLeast2 (maskContinuation# (word8ToWordCompat# v1))+                 | otherwise                               -> StepBack (toChar# (word8ToWordCompat# v1)) prevOfs1+  where+    sz1 = CountOf 1+    !prevOfs1 = offset `offsetMinusE` sz1+    prevOfs2 = prevOfs1 `offsetMinusE` sz1+    prevOfs3 = prevOfs2 `offsetMinusE` sz1+    prevOfs4 = prevOfs3 `offsetMinusE` sz1+    atLeast2 !v  =+        case index ba prevOfs2 of+            (W8# v2) | isContinuation# (word8ToWordCompat# v2) -> atLeast3 (or# (uncheckedShiftL# (maskContinuation# (word8ToWordCompat# v2)) 6#) v)+                     | otherwise                               -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader2# (word8ToWordCompat# v2)) 6#) v)) prevOfs2+    atLeast3 !v =+        case index ba prevOfs3 of+            (W8# v3) | isContinuation# (word8ToWordCompat# v3) -> atLeast4 (or# (uncheckedShiftL# (maskContinuation# (word8ToWordCompat# v3)) 12#) v)+                     | otherwise                               -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader3# (word8ToWordCompat# v3)) 12#) v)) prevOfs3+    atLeast4 !v =+        case index ba prevOfs4 of+            (W8# v4) -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader4# (word8ToWordCompat# v4)) 18#) v)) prevOfs4++prevSkip :: Indexable container Word8 => container -> Offset Word8 -> Offset Word8+prevSkip ba offset = loop (offset `offsetMinusE` sz1)+  where+    sz1 = CountOf 1+    loop o+        | isContinuation (index ba o) = loop (o `offsetMinusE` sz1)+        | otherwise                       = o++writeASCII :: (PrimMonad prim, RandomAccess container prim Word8)+           => container -> Offset8 -> Char7 -> prim ()+writeASCII mba !i (Char7 c) = write mba i c+{-# INLINE writeASCII #-}++writeUTF8 :: (PrimMonad prim, RandomAccess container prim Word8)+          => container -> Offset8 -> Char -> prim Offset8+writeUTF8 mba !i !c+    | bool# (ltWord# x 0x80##   ) = encode1+    | bool# (ltWord# x 0x800##  ) = encode2+    | bool# (ltWord# x 0x10000##) = encode3+    | otherwise                   = encode4+  where+    !(I# xi) = fromEnum c+    !x       = int2Word# xi++    encode1 = write mba i (W8# (wordToWord8Compat# x)) >> pure (i + Offset 1)+    encode2 = do+        let x1  = or# (uncheckedShiftRL# x 6#) 0xc0##+            x2  = toContinuation x+        write mba i     (W8# (wordToWord8Compat# x1))+        write mba (i+1) (W8# (wordToWord8Compat# x2))+        pure (i + Offset 2)++    encode3 = do+        let x1  = or# (uncheckedShiftRL# x 12#) 0xe0##+            x2  = toContinuation (uncheckedShiftRL# x 6#)+            x3  = toContinuation x+        write mba i            (W8# (wordToWord8Compat# x1))+        write mba (i+Offset 1) (W8# (wordToWord8Compat# x2))+        write mba (i+Offset 2) (W8# (wordToWord8Compat# x3))+        pure (i + Offset 3)++    encode4 = do+        let x1  = or# (uncheckedShiftRL# x 18#) 0xf0##+            x2  = toContinuation (uncheckedShiftRL# x 12#)+            x3  = toContinuation (uncheckedShiftRL# x 6#)+            x4  = toContinuation x+        write mba i            (W8# (wordToWord8Compat# x1))+        write mba (i+Offset 1) (W8# (wordToWord8Compat# x2))+        write mba (i+Offset 2) (W8# (wordToWord8Compat# x3))+        write mba (i+Offset 3) (W8# (wordToWord8Compat# x4))+        pure (i + Offset 4)++    toContinuation :: Word# -> Word#+    toContinuation w = or# (and# w 0x3f##) 0x80##+{-# INLINE writeUTF8 #-}++toList :: Indexable container Word8 => container -> Offset Word8 -> Offset Word8 -> [Char]+toList ba !start !end = loop start+  where+    loop !idx+        | idx == end = []+        | otherwise  = c : loop idx'+      where (Step c idx') = next ba idx++all :: Indexable container Word8+    => (Char -> Bool) -> container -> Offset Word8 -> Offset Word8 -> Bool+all predicate ba start end = loop start+  where+    loop !idx+        | idx == end  = True+        | predicate c = loop idx'+        | otherwise   = False+      where (Step c idx') = next ba idx+{-# INLINE all #-}++any :: Indexable container Word8+    => (Char -> Bool) -> container -> Offset Word8 -> Offset Word8 -> Bool+any predicate ba start end = loop start+  where+    loop !idx+        | idx == end  = False+        | predicate c = True+        | otherwise   = loop idx'+      where (Step c idx') = next ba idx+{-# INLINE any #-}++foldr :: Indexable container Word8+      => container -> Offset Word8 -> Offset Word8 -> (Char -> a -> a) -> a -> a+foldr dat start end f acc = loop start+  where+    loop !i+        | i == end  = acc+        | otherwise =+            let (Step c i') = next dat i+             in c `f` loop i'+{-# INLINE foldr #-}++length :: (Indexable container Word8, Indexable container Word64)+       => container -> Offset Word8 -> Offset Word8 -> CountOf Char+length dat start end+    | start == end = 0+    | otherwise    = processStart 0 start+  where+    end64 :: Offset Word64+    end64 = offsetInElements end++    prx64 :: Proxy Word64+    prx64 = Proxy++    mask64_80 :: Word64+    mask64_80 = 0x8080808080808080++    processStart :: CountOf Char -> Offset Word8 -> CountOf Char+    processStart !c !i+        | i == end                = c+        | offsetIsAligned prx64 i = processAligned c (offsetInElements i)+        | otherwise               =+            let h    = index dat i+                cont = (h .&. 0xc0) == 0x80+                c'   = if cont then c else c+1+             in processStart c' (i+1)+    processAligned :: CountOf Char -> Offset Word64 -> CountOf Char+    processAligned !c !i+        | i >= end64 = processEnd c (offsetInBytes i)+        | otherwise  =+            let !h   = index dat i -- Word64+                !h80 = h .&. mask64_80+             in if h80 == 0+                 then processAligned (c+8) (i+1)+                 else let !nbAscii = if h80 == mask64_80 then 0 else CountOf (8 - popCount h80)+                          !nbHigh  = CountOf $ popCount (h .&. (h80 `unsafeShiftR` 1))+                       in processAligned (c + nbAscii + nbHigh) (i+1)+    processEnd !c !i+        | i == end  = c+        | otherwise =+            let h    = index dat i+                cont = (h .&. 0xc0) == 0x80+                c'   = if cont then c else c+1+             in processStart c' (i+1)+{-# INLINE length #-}++reverse :: (PrimMonad prim, Indexable container Word8)+        => MutableByteArray# (PrimState prim) -- ^ Destination buffer+        -> Offset Word8                       -- ^ Destination start+        -> container                          -- ^ Source buffer+        -> Offset Word8                       -- ^ Source start+        -> Offset Word8                       -- ^ Source end+        -> prim ()+reverse dst dstOfs src start end+    | start == end = pure ()+    | otherwise    = loop (dstOfs `offsetPlusE` (offsetAsSize (end `offsetSub` start)) `offsetSub` 1) start+  where+    loop !d !s+        | s == end        = pure ()+        | headerIsAscii h = primMbaWrite dst d (stepAsciiRawValue h) >> loop (d `offsetSub` 1) (s + 1)+        | otherwise       = do+            case getNbBytes h of+                1 -> do+                    primMbaWrite dst (d `offsetSub` 1) (stepAsciiRawValue h)+                    primMbaWrite dst d                 (index src (s + 1))+                    loop (d `offsetSub` 2) (s + 2)+                2 -> do+                    primMbaWrite dst (d `offsetSub` 2) (stepAsciiRawValue h)+                    primMbaWrite dst (d `offsetSub` 1) (index src (s + 1))+                    primMbaWrite dst d                 (index src (s + 2))+                    loop (d `offsetSub` 3) (s + 3)+                3 -> do+                    primMbaWrite dst (d `offsetSub` 3) (stepAsciiRawValue h)+                    primMbaWrite dst (d `offsetSub` 2) (index src (s + 1))+                    primMbaWrite dst (d `offsetSub` 1) (index src (s + 2))+                    primMbaWrite dst d                 (index src (s + 3))+                    loop (d `offsetSub` 4) (s + 4)+                _ -> error "impossible"+      where h = nextAscii src s+{-# INLINE reverse #-}
+ Basement/Alg/XorShift.hs view
@@ -0,0 +1,64 @@+-- |+-- Module      : Foundation.Random.XorShift+-- License     : BSD-style+--+-- XorShift variant: Xoroshiro128++-- <https://en.wikipedia.org/wiki/Xoroshiro128%2B>+--+-- Xoroshiro128+ is a PRNG that uses a shift/rotate-based linear transformation.+-- This is lar+--+-- C implementation at:+-- <http://xoroshiro.di.unimi.it/xoroshiro128plus.c>+--+module Basement.Alg.XorShift+    ( State(..)+    , next+    , nextDouble+    , jump+    ) where++import           Data.Word+import           Data.Bits+import           Basement.Compat.Base+import           Basement.Floating (wordToDouble)+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive++-- | State of Xoroshiro128 plus+data State = State {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64++-- | Given a state, call the function 'f' with the generated Word64 and the next State+next :: State -> (Word64 -> State -> a) -> a+next (State s0 s1prev) f = f ran stNext+  where+    !stNext = State s0' s1'+    !ran    = s0 + s1prev+    !s1     = s0 `xor` s1prev+    s0'     = (s0 `rotateL` 55) `xor` s1 `xor` (s1 `unsafeShiftL` 14)+    s1'     = (s1 `rotateL` 36)++-- | Same as 'next' but give a random value of type Double in the range of [0.0 .. 1.0]+nextDouble :: State -> (Double -> State -> a) -> a+nextDouble st f = next st $ \w -> f (toDouble w)+  where+    -- generate a number in the interval [1..2[ by bit manipulation.+    -- this generate double with a ~2^52+    toDouble w = wordToDouble (upperMask .|. (w .&. lowerMask)) - 1.0+      where+        upperMask = 0x3FF0000000000000+        lowerMask = 0x000FFFFFFFFFFFFF++-- | Jump the state by 2^64 calls of next+jump :: State -> State+jump (State s0 s1) = withK 0xd86b048b86aa9922+                   $ withK 0xbeac0467eba5facb+                   $ (State 0 0)+  where+    withK :: Word64 -> State -> State+    withK !k = loop 0+      where+        loop !i st@(State c0 c1)+            | i == 64     = st+            | testBit k i = loop (i+1) (State (c0 `xor` s0) (c1 `xor` s1))+            | otherwise   = st
+ Basement/Base16.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE MagicHash     #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns  #-}+module Basement.Base16+    ( unsafeConvertByte+    , hexWord16+    , hexWord32+    , escapeByte+    , Base16Escape(..)+    ) where++import GHC.Prim+import GHC.Types+import GHC.Word+import Basement.HeadHackageUtils+import Basement.Types.Char7++data Base16Escape = Base16Escape {-# UNPACK #-} !Char7 {-# UNPACK #-} !Char7++-- | Convert a byte value in Word# to two Word#s containing+-- the hexadecimal representation of the Word#+--+-- The output words# are guaranteed to be included in the 0 to 2^7-1 range+--+-- Note that calling convertByte with a value greater than 256+-- will cause segfault or other horrible effect.+unsafeConvertByte :: Word# -> (# Word#, Word# #)+unsafeConvertByte b = (# r tableHi b, r tableLo b #)+  where+    r :: Table -> Word# -> Word#+    r (Table !table) index = word8ToWordCompat# (indexWord8OffAddr# table (word2Int# index))+{-# INLINE unsafeConvertByte #-}++escapeByte :: Word8 -> Base16Escape+escapeByte !(W8# b) = Base16Escape (r tableHi (word8ToWordCompat# b)) (r tableLo (word8ToWordCompat# b))+  where+    r :: Table -> Word# -> Char7+    r (Table !table) index = Char7 (W8# (indexWord8OffAddr# table (word2Int# index)))+{-# INLINE escapeByte #-}++-- | hex word16+hexWord16 :: Word16 -> (Char, Char, Char, Char)+hexWord16 (W16# w) = (toChar w1,toChar w2,toChar w3,toChar w4)+  where+    toChar :: Word# -> Char+    toChar c = C# (chr# (word2Int# c))+    !(# w1, w2 #) = unsafeConvertByte (uncheckedShiftRL# (word16ToWordCompat# w) 8#)+    !(# w3, w4 #) = unsafeConvertByte (and# (word16ToWordCompat# w) 0xff##)++-- | hex word32+hexWord32 :: Word32 -> (Char, Char, Char, Char, Char, Char, Char, Char)+hexWord32 (W32# w) = (toChar w1,toChar w2,toChar w3,toChar w4+                     ,toChar w5,toChar w6,toChar w7,toChar w8)+  where+    toChar :: Word# -> Char+    toChar c = C# (chr# (word2Int# c))+    !(# w1, w2 #) = unsafeConvertByte (uncheckedShiftRL# (word32ToWordCompat# w) 24#)+    !(# w3, w4 #) = unsafeConvertByte (and# (uncheckedShiftRL# (word32ToWordCompat# w) 16#) 0xff##)+    !(# w5, w6 #) = unsafeConvertByte (and# (uncheckedShiftRL# (word32ToWordCompat# w) 8#) 0xff##)+    !(# w7, w8 #) = unsafeConvertByte (and# (word32ToWordCompat# w) 0xff##)++data Table = Table Addr#++tableLo:: Table+tableLo = Table+    "0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef\+    \0123456789abcdef0123456789abcdef"#++tableHi :: Table+tableHi = Table+    "00000000000000001111111111111111\+    \22222222222222223333333333333333\+    \44444444444444445555555555555555\+    \66666666666666667777777777777777\+    \88888888888888889999999999999999\+    \aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\+    \ccccccccccccccccdddddddddddddddd\+    \eeeeeeeeeeeeeeeeffffffffffffffff"#+
+ Basement/Bindings/Memory.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+module Basement.Bindings.Memory+    where++import GHC.IO+import GHC.Prim+import GHC.Word+import Basement.Compat.C.Types+import Foreign.Ptr+import Basement.Types.OffsetSize++foreign import ccall unsafe "_foundation_memcmp" sysHsMemcmpBaBa ::+    ByteArray# -> Offset Word8 -> ByteArray# -> Offset Word8 -> CountOf Word8 -> IO CInt++foreign import ccall unsafe "_foundation_memcmp" sysHsMemcmpBaPtr ::+    ByteArray# -> Offset Word8 -> Ptr a -> Offset Word8 -> CountOf Word8 -> IO CInt++foreign import ccall unsafe "_foundation_memcmp" sysHsMemcmpPtrBa ::+    Ptr a -> Offset Word8 -> ByteArray# -> Offset Word8 -> CountOf Word8 -> IO CInt++foreign import ccall unsafe "_foundation_memcmp" sysHsMemcmpPtrPtr ::+    Ptr a -> Offset Word8 -> Ptr b -> Offset Word8 -> CountOf Word8 -> IO CInt++foreign import ccall unsafe "_foundation_mem_findbyte" sysHsMemFindByteBa ::+    ByteArray# -> Offset Word8 -> Offset Word8 -> Word8 -> Offset Word8++foreign import ccall unsafe "_foundation_mem_findbyte" sysHsMemFindByteAddr ::+    Addr# -> Offset Word8 -> Offset Word8 -> Word8 -> Offset Word8
+ Basement/Bits.hs view
@@ -0,0 +1,614 @@+-- |+-- Module      : Basement.Bits+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NegativeLiterals #-}++#include "MachDeps.h"++module Basement.Bits+    ( BitOps(..)+    , FiniteBitsOps(..)+    , Bits+    , toBits+    , allOne+    ) where++import Basement.Compat.Base+import Basement.Compat.Natural+import Basement.Numerical.Additive+import Basement.Numerical.Subtractive+import Basement.Numerical.Multiplicative+import Basement.Types.OffsetSize+import Basement.Types.Word128 (Word128)+import qualified Basement.Types.Word128 as Word128+import Basement.Types.Word256 (Word256)+import qualified Basement.Types.Word256 as Word256+import Basement.IntegralConv (wordToInt)+import Basement.Nat+import Basement.HeadHackageUtils++import qualified Prelude+import qualified Data.Bits as OldBits+import Data.Maybe (fromMaybe)+import Data.Proxy+import GHC.Base hiding ((.))+import GHC.Prim+import GHC.Types+import GHC.Word+import GHC.Int++#if WORD_SIZE_IN_BITS < 64+import GHC.IntWord64+#endif++-- | operation over finite bits+class FiniteBitsOps bits where+    -- | get the number of bits in the given object+    --+    numberOfBits :: bits -> CountOf Bool++    -- | rotate the given bit set.+    rotateL :: bits -> CountOf Bool -> bits+    -- | rotate the given bit set.+    rotateR :: bits -> CountOf Bool -> bits++    -- | count of number of bit set to 1 in the given bit set.+    popCount :: bits -> CountOf Bool++    -- | reverse all bits in the argument+    bitFlip   :: bits -> bits++    -- | count of the number of leading zeros+    countLeadingZeros :: bits -> CountOf Bool+    default countLeadingZeros :: BitOps bits => bits -> CountOf Bool+    countLeadingZeros n = loop stop azero+      where+        stop = numberOfBits n+        loop idx count+            | idx == azero = count+            | isBitSet n (sizeAsOffset idx) = count+            | otherwise = loop (fromMaybe azero (idx - 1)) (count + 1)++    -- | count of the number of trailing zeros+    countTrailingZeros :: bits -> CountOf Bool+    default countTrailingZeros :: BitOps bits => bits -> CountOf Bool+    countTrailingZeros n = loop azero+      where+        stop = numberOfBits n+        loop count+            | count == stop = count+            | isBitSet n (sizeAsOffset count) = count+            | otherwise = loop (count + 1)++-- | operation over bits+class BitOps bits where+    (.&.)     :: bits -> bits -> bits+    (.|.)     :: bits -> bits -> bits+    (.^.)     :: bits -> bits -> bits+    (.<<.)    :: bits -> CountOf Bool -> bits+    (.>>.)    :: bits -> CountOf Bool -> bits+    -- | construct a bit set with the bit at the given index set.+    bit       :: Offset Bool -> bits+    default bit :: Integral bits => Offset Bool -> bits+    bit n = 1 .<<. (offsetAsSize n)++    -- | test the bit at the given index is set+    isBitSet  :: bits -> Offset Bool -> Bool+    default isBitSet :: (Integral bits, Eq bits) => bits -> Offset Bool -> Bool+    isBitSet x n = x .&. (bit n) /= 0++    -- | set the bit at the given index+    setBit    :: bits -> Offset Bool -> bits+    default setBit :: Integral bits => bits -> Offset Bool -> bits+    setBit x n = x .|. (bit n)++    -- | clear the bit at the given index+    clearBit  :: bits -> Offset Bool -> bits+    default clearBit :: FiniteBitsOps bits => bits -> Offset Bool -> bits+    clearBit x n = x .&. (bitFlip (bit n))++infixl 8 .<<., .>>., `rotateL`, `rotateR`+infixl 7 .&.+infixl 6 .^.+infixl 5 .|.++-- | Bool set of 'n' bits.+--+newtype Bits (n :: Nat) = Bits { bitsToNatural :: Natural }+  deriving (Show, Eq, Ord, Typeable)++-- | convenient Type Constraint Alias fot 'Bits' functions+type SizeValid n = (KnownNat n, 1 <= n)++-- convert an 'Int' into a 'Natural'.+-- This functions is not meant to be exported+lift :: Int -> Natural+lift = Prelude.fromIntegral+{-# INLINABLE lift #-}++-- | convert the given 'Natural' into a 'Bits' of size 'n'+--+-- if bits that are not within the boundaries of the 'Bits n' will be truncated.+toBits :: SizeValid n => Natural -> Bits n+toBits nat = Bits nat .&. allOne++-- | construct a 'Bits' with all bits set.+--+-- this function is equivalet to 'maxBound'+allOne :: forall n . SizeValid n => Bits n+allOne = Bits (2 Prelude.^ n Prelude.- midentity)+  where+    n = natVal (Proxy @n)++instance SizeValid n => Enum (Bits n) where+    toEnum i | i < 0 && lift i > bitsToNatural maxi = error "Bits n not within bound"+             | otherwise                            = Bits (lift i)+      where maxi = allOne :: Bits n+    fromEnum (Bits n) = fromEnum n+instance SizeValid n => Bounded (Bits n) where+    minBound = azero+    maxBound = allOne+instance SizeValid n => Additive (Bits n) where+    azero = Bits 0+    (+) (Bits a) (Bits b) = toBits (a + b)+    scale n (Bits a) = toBits (scale n a)+instance SizeValid n => Subtractive (Bits n) where+    type Difference (Bits n) = Bits n+    (-) (Bits a) (Bits b) = maybe azero toBits (a - b)+instance SizeValid n => Multiplicative (Bits n) where+    midentity = Bits 1+    (*) (Bits a) (Bits b) = Bits (a Prelude.* b)+instance SizeValid n => IDivisible (Bits n) where+    div (Bits a) (Bits b) = Bits (a `Prelude.div` b)+    mod (Bits a) (Bits b) = Bits (a `Prelude.mod` b)+    divMod (Bits a) (Bits b) = let (q, r) = Prelude.divMod a b in (Bits q, Bits r)++instance SizeValid n => BitOps (Bits n) where+    (.&.)    (Bits a) (Bits b)    = Bits (a OldBits..&. b)+    (.|.)    (Bits a) (Bits b)    = Bits (a OldBits..|. b)+    (.^.)    (Bits a) (Bits b)    = Bits (a `OldBits.xor` b)+    (.<<.)   (Bits a) (CountOf w) = Bits (a `OldBits.shiftL` w)+    (.>>.)   (Bits a) (CountOf w) = Bits (a `OldBits.shiftR` w)+    bit               (Offset w)  = Bits (OldBits.bit w)+    isBitSet (Bits a) (Offset w)  = OldBits.testBit a w+    setBit   (Bits a) (Offset w)  = Bits (OldBits.setBit a w)+    clearBit (Bits a) (Offset w)  = Bits (OldBits.clearBit a w)+instance (SizeValid n, NatWithinBound (CountOf Bool) n) => FiniteBitsOps (Bits n) where+    bitFlip (Bits a) = Bits (OldBits.complement a)+    numberOfBits _ = natValCountOf (Proxy @n)+    rotateL a i = (a .<<. i) .|. (a .>>. d)+      where+        n = natValCountOf (Proxy :: Proxy n)+        d = fromMaybe (fromMaybe (error "impossible") (i - n)) (n - i)+    rotateR a i = (a .>>. i) .|. (a .<<. d)+      where+        n = natValCountOf (Proxy :: Proxy n)+        d = fromMaybe (fromMaybe (error "impossible") (i - n)) (n - i)+    popCount (Bits n) = CountOf (OldBits.popCount n)++-- Bool ------------------------------------------------------------------------++instance FiniteBitsOps Bool where+    numberOfBits _ = 1+    rotateL x _ = x+    rotateR x _ = x+    popCount True = 1+    popCount False = 0+    bitFlip  = not+    countLeadingZeros True  = 0+    countLeadingZeros False = 1+    countTrailingZeros True  = 0+    countTrailingZeros False = 1+instance BitOps Bool where+    (.&.) = (&&)+    (.|.) = (||)+    (.^.) = (/=)+    x .<<. 0 = x+    _ .<<. _ = False+    x .>>. 0 = x+    _ .>>. _ = False+    bit 0 = True+    bit _ = False+    isBitSet x 0 = x+    isBitSet _ _ = False+    setBit _ 0 = True+    setBit _ _ = False+    clearBit _ 0 = False+    clearBit x _ = x++-- Word8 ----------------------------------------------------------------------++instance FiniteBitsOps Word8 where+    numberOfBits _ = 8+    rotateL (W8# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W8# x#+        | otherwise  = W8# (narrow8WordCompat# ((word8ToWordCompat# x# `uncheckedShiftL#` i'#) `or#`+                                          (word8ToWordCompat# x# `uncheckedShiftRL#` (8# -# i'#))))+      where+        !i'# = word2Int# (int2Word# i# `and#` 7##)+    rotateR (W8# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W8# x#+        | otherwise  = W8# (narrow8WordCompat# ((word8ToWordCompat# x# `uncheckedShiftRL#` i'#) `or#`+                                          (word8ToWordCompat# x# `uncheckedShiftL#` (8# -# i'#))))+      where+        !i'# = word2Int# (int2Word# i# `and#` 7##)+    bitFlip (W8# x#) = W8# (wordToWord8Compat# (word8ToWordCompat# x# `xor#` word8ToWordCompat# mb#))+        where !(W8# mb#) = maxBound+    popCount (W8# x#) = CountOf $ wordToInt (W# (popCnt8# (word8ToWordCompat# x#)))+    countLeadingZeros (W8# w#) = CountOf $ wordToInt (W# (clz8# (word8ToWordCompat# w#)))+    countTrailingZeros (W8# w#) = CountOf $ wordToInt (W# (ctz8# (word8ToWordCompat# w#)))+instance BitOps Word8 where+    (W8# x#) .&. (W8# y#)   = W8# (wordToWord8Compat# (word8ToWordCompat# x# `and#` word8ToWordCompat# y#))+    (W8# x#) .|. (W8# y#)   = W8# (wordToWord8Compat# (word8ToWordCompat# x# `or#`  word8ToWordCompat# y#))+    (W8# x#) .^. (W8# y#)   = W8# (wordToWord8Compat# (word8ToWordCompat# x# `xor#` word8ToWordCompat# y#))+    (W8# x#) .<<. (CountOf (I# i#)) = W8# (narrow8WordCompat# (word8ToWordCompat# x# `shiftL#` i#))+    (W8# x#) .>>. (CountOf (I# i#)) = W8# (narrow8WordCompat# (word8ToWordCompat# x# `shiftRL#` i#))++-- Word16 ---------------------------------------------------------------------++instance FiniteBitsOps Word16 where+    numberOfBits _ = 16+    rotateL (W16# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W16# x#+        | otherwise  = W16# (narrow16WordCompat# ((word16ToWordCompat# x# `uncheckedShiftL#` i'#) `or#`+                                            (word16ToWordCompat# x# `uncheckedShiftRL#` (16# -# i'#))))+      where+        !i'# = word2Int# (int2Word# i# `and#` 15##)+    rotateR (W16# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W16# x#+        | otherwise  = W16# (narrow16WordCompat# ((word16ToWordCompat# x# `uncheckedShiftRL#` i'#) `or#`+                                            (word16ToWordCompat# x# `uncheckedShiftL#` (16# -# i'#))))+      where+        !i'# = word2Int# (int2Word# i# `and#` 15##)+    bitFlip (W16# x#) = W16# (wordToWord16Compat# (word16ToWordCompat# x# `xor#` word16ToWordCompat# mb#))+        where !(W16# mb#) = maxBound+    popCount (W16# x#) = CountOf $ wordToInt (W# (popCnt16# (word16ToWordCompat# x#)))+    countLeadingZeros (W16# w#) = CountOf $ wordToInt (W# (clz16# (word16ToWordCompat# w#)))+    countTrailingZeros (W16# w#) = CountOf $ wordToInt (W# (ctz16# (word16ToWordCompat# w#)))+instance BitOps Word16 where+    (W16# x#) .&. (W16# y#)   = W16# (wordToWord16Compat# (word16ToWordCompat# x# `and#` word16ToWordCompat# y#))+    (W16# x#) .|. (W16# y#)   = W16# (wordToWord16Compat# (word16ToWordCompat# x# `or#`  word16ToWordCompat# y#))+    (W16# x#) .^. (W16# y#)   = W16# (wordToWord16Compat# (word16ToWordCompat# x# `xor#` word16ToWordCompat# y#))+    (W16# x#) .<<. (CountOf (I# i#)) = W16# (narrow16WordCompat# (word16ToWordCompat# x# `shiftL#` i#))+    (W16# x#) .>>. (CountOf (I# i#)) = W16# (narrow16WordCompat# (word16ToWordCompat# x# `shiftRL#` i#))++-- Word32 ---------------------------------------------------------------------++instance FiniteBitsOps Word32 where+    numberOfBits _ = 32+    rotateL (W32# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W32# x#+        | otherwise  = W32# (narrow32WordCompat# ((word32ToWordCompat# x# `uncheckedShiftL#` i'#) `or#`+                                            (word32ToWordCompat# x# `uncheckedShiftRL#` (32# -# i'#))))+      where+        !i'# = word2Int# (int2Word# i# `and#` 31##)+    rotateR (W32# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W32# x#+        | otherwise  = W32# (narrow32WordCompat# ((word32ToWordCompat# x# `uncheckedShiftRL#` i'#) `or#`+                                            (word32ToWordCompat# x# `uncheckedShiftL#` (32# -# i'#))))+      where+        !i'# = word2Int# (int2Word# i# `and#` 31##)+    bitFlip (W32# x#) = W32# (wordToWord32Compat# (word32ToWordCompat# x# `xor#` word32ToWordCompat# mb#))+        where !(W32# mb#) = maxBound+    popCount (W32# x#) = CountOf $ wordToInt (W# (popCnt32# (word32ToWordCompat# x#)))+    countLeadingZeros (W32# w#) = CountOf $ wordToInt (W# (clz32# (word32ToWordCompat# w#)))+    countTrailingZeros (W32# w#) = CountOf $ wordToInt (W# (ctz32# (word32ToWordCompat# w#)))+instance BitOps Word32 where+    (W32# x#) .&. (W32# y#)   = W32# (wordToWord32Compat# (word32ToWordCompat# x# `and#` word32ToWordCompat# y#))+    (W32# x#) .|. (W32# y#)   = W32# (wordToWord32Compat# (word32ToWordCompat# x# `or#`  word32ToWordCompat# y#))+    (W32# x#) .^. (W32# y#)   = W32# (wordToWord32Compat# (word32ToWordCompat# x# `xor#` word32ToWordCompat# y#))+    (W32# x#) .<<. (CountOf (I# i#)) = W32# (narrow32WordCompat# (word32ToWordCompat# x# `shiftL#` i#))+    (W32# x#) .>>. (CountOf (I# i#)) = W32# (narrow32WordCompat# (word32ToWordCompat# x# `shiftRL#` i#))++-- Word ---------------------------------------------------------------------++#if WORD_SIZE_IN_BITS == 64+instance FiniteBitsOps Word where+    numberOfBits _ = 64+    rotateL (W# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W# x#+        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#`+                           (x# `uncheckedShiftRL#` (64# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    rotateR (W# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W# x#+        | otherwise  = W# ((x# `uncheckedShiftRL#` i'#) `or#`+                           (x# `uncheckedShiftL#` (64# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    bitFlip (W# x#) = W# (x# `xor#` mb#)+        where !(W# mb#) = maxBound+    popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# x#))+    countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# w#))+    countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# w#))+#else+instance FiniteBitsOps Word where+    numberOfBits _ = 32+    rotateL (W# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W# x#+        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#`+                           (x# `uncheckedShiftRL#` (32# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 31##)+    rotateR (W# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W# x#+        | otherwise  = W# ((x# `uncheckedShiftRL#` i'#) `or#`+                           (x# `uncheckedShiftL#` (32# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 31##)+    bitFlip (W# x#) = W# (x# `xor#` mb#)+        where !(W# mb#) = maxBound+    popCount (W# x#) = CountOf $ wordToInt (W# (popCnt32# x#))+    countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz32# w#))+    countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz32# w#))+#endif++instance BitOps Word where+    (W# x#) .&. (W# y#)   = W# (x# `and#` y#)+    (W# x#) .|. (W# y#)   = W# (x# `or#`  y#)+    (W# x#) .^. (W# y#)   = W# (x# `xor#` y#)+    (W# x#) .<<. (CountOf (I# i#)) = W# ((x# `shiftL#` i#))+    (W# x#) .>>. (CountOf (I# i#)) = W# ((x# `shiftRL#` i#))++-- Word64 ---------------------------------------------------------------------++#if WORD_SIZE_IN_BITS == 64+instance FiniteBitsOps Word64 where+    numberOfBits _ = 64+    rotateL (W64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W64# x#+        | otherwise  = W64# ((x# `uncheckedShiftL#` i'#) `or#`+                             (x# `uncheckedShiftRL#` (64# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    rotateR (W64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W64# x#+        | otherwise  = W64# ((x# `uncheckedShiftRL#` i'#) `or#`+                             (x# `uncheckedShiftL#` (64# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    bitFlip (W64# x#) = W64# (x# `xor#` mb#)+        where !(W64# mb#) = maxBound+    popCount (W64# x#) = CountOf $ wordToInt (W# (popCnt64# x#))+    countLeadingZeros (W64# w#) = CountOf $ wordToInt (W# (clz64# w#))+    countTrailingZeros (W64# w#) = CountOf $ wordToInt (W# (ctz64# w#))+instance BitOps Word64 where+    (W64# x#) .&. (W64# y#)   = W64# (x# `and#` y#)+    (W64# x#) .|. (W64# y#)   = W64# (x# `or#`  y#)+    (W64# x#) .^. (W64# y#)   = W64# (x# `xor#` y#)+    (W64# x#) .<<. (CountOf (I# i#)) = W64# (x# `shiftL#` i#)+    (W64# x#) .>>. (CountOf (I# i#)) = W64# (x# `shiftRL#` i#)+#else+instance FiniteBitsOps Word64 where+    numberOfBits _ = 64+    rotateL (W64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W64# x#+        | otherwise  = W64# ((x# `uncheckedShiftL64#` i'#) `or64#`+                             (x# `uncheckedShiftRL64#` (64# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    rotateR (W64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = W64# x#+        | otherwise  = W64# ((x# `uncheckedShiftRL64#` i'#) `or64#`+                             (x# `uncheckedShiftL64#` (64# -# i'#)))+      where+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    bitFlip (W64# x#) = W64# (not64# x#)+    popCount (W64# x#) = CountOf $ wordToInt (W# (popCnt64# x#))+    countLeadingZeros (W64# w#) = CountOf $ wordToInt (W# (clz64# w#))+    countTrailingZeros (W64# w#) = CountOf $ wordToInt (W# (ctz64# w#))+instance BitOps Word64 where+    (W64# x#) .&. (W64# y#)   = W64# (x# `and64#` y#)+    (W64# x#) .|. (W64# y#)   = W64# (x# `or64#`  y#)+    (W64# x#) .^. (W64# y#)   = W64# (x# `xor64#` y#)+    (W64# x#) .<<. (CountOf (I# i#)) = W64# (x# `shiftL64#` i#)+    (W64# x#) .>>. (CountOf (I# i#)) = W64# (x# `shiftRL64#` i#)++shiftL64#, shiftRL64# :: Word64# -> Int# -> Word64#+a `shiftL64#` b  | isTrue# (b >=# 64#) = wordToWord64# 0##+                 | otherwise           = a `uncheckedShiftL64#` b+a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0##+                 | otherwise           = a `uncheckedShiftRL64#` b+#endif++-- Word128 --------------------------------------------------------------------++instance FiniteBitsOps Word128 where+    numberOfBits _ = 128+    rotateL w (CountOf n) = Word128.rotateL w n+    rotateR w (CountOf n) = Word128.rotateR w n+    bitFlip = Word128.complement+    popCount = CountOf . Word128.popCount+instance BitOps Word128 where+    (.&.) = Word128.bitwiseAnd+    (.|.) = Word128.bitwiseOr+    (.^.) = Word128.bitwiseXor+    (.<<.) w (CountOf n) = Word128.shiftL w n+    (.>>.) w (CountOf n) = Word128.shiftR w n++-- Word256 --------------------------------------------------------------------++instance FiniteBitsOps Word256 where+    numberOfBits _ = 256+    rotateL w (CountOf n) = Word256.rotateL w n+    rotateR w (CountOf n) = Word256.rotateR w n+    bitFlip = Word256.complement+    popCount = CountOf . Word256.popCount+instance BitOps Word256 where+    (.&.) = Word256.bitwiseAnd+    (.|.) = Word256.bitwiseOr+    (.^.) = Word256.bitwiseXor+    (.<<.) w (CountOf n) = Word256.shiftL w n+    (.>>.) w (CountOf n) = Word256.shiftR w n++-- Int8 -----------------------------------------------------------------------++instance FiniteBitsOps Int8 where+    numberOfBits _ = 8+    rotateL (I8# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I8# x#+        | otherwise  = I8# (narrow8IntCompat# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`+                                                    (x'# `uncheckedShiftRL#` (8# -# i'#)))))+      where+        !x'# = narrow8Word# (int2Word# (int8ToIntCompat# x#))+        !i'# = word2Int# (int2Word# i# `and#` 7##)+    rotateR (I8# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I8# x#+        | otherwise  = I8# (narrow8IntCompat# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`+                                                    (x'# `uncheckedShiftL#` (8# -# i'#)))))+      where+        !x'# = narrow8Word# (int2Word# (int8ToIntCompat# x#))+        !i'# = word2Int# (int2Word# i# `and#` 7##)+    bitFlip (I8# x#) = I8# (intToInt8Compat# (word2Int# (not# (int2Word# (int8ToIntCompat# x#)))))+    popCount (I8# x#) = CountOf $ wordToInt (W# (popCnt8# (int2Word# (int8ToIntCompat# x#))))+    countLeadingZeros (I8# w#) = CountOf $ wordToInt (W# (clz8# (int2Word# (int8ToIntCompat# w#))))+    countTrailingZeros (I8# w#) = CountOf $ wordToInt (W# (ctz8# (int2Word# (int8ToIntCompat# w#))))+instance BitOps Int8 where+    (I8# x#) .&. (I8# y#)   = I8# (intToInt8Compat# (int8ToIntCompat# x# `andI#` int8ToIntCompat# y#))+    (I8# x#) .|. (I8# y#)   = I8# (intToInt8Compat# (int8ToIntCompat# x# `orI#`  int8ToIntCompat# y#))+    (I8# x#) .^. (I8# y#)   = I8# (intToInt8Compat# (int8ToIntCompat# x# `xorI#` int8ToIntCompat# y#))+    (I8# x#) .<<. (CountOf (I# i#)) = I8# (narrow8IntCompat# (int8ToIntCompat# x# `iShiftL#`  i#))+    (I8# x#) .>>. (CountOf (I# i#)) = I8# (narrow8IntCompat# (int8ToIntCompat# x# `iShiftRL#` i#))++-- Int16 ----------------------------------------------------------------------++instance FiniteBitsOps Int16 where+    numberOfBits _ = 16+    rotateL (I16# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I16# x#+        | otherwise  = I16# (narrow16IntCompat# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`+                                                      (x'# `uncheckedShiftRL#` (16# -# i'#)))))+      where+        !x'# = narrow16Word# (int2Word# (int16ToIntCompat# x#))+        !i'# = word2Int# (int2Word# i# `and#` 15##)+    rotateR (I16# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I16# x#+        | otherwise  = I16# (narrow16IntCompat# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`+                                                      (x'# `uncheckedShiftL#` (16# -# i'#)))))+      where+        !x'# = narrow16Word# (int2Word# (int16ToIntCompat# x#))+        !i'# = word2Int# (int2Word# i# `and#` 15##)+    bitFlip (I16# x#) = I16# (intToInt16Compat# (word2Int# (not# (int2Word# (int16ToIntCompat# x#)))))+    popCount (I16# x#) = CountOf $ wordToInt (W# (popCnt16# (int2Word# (int16ToIntCompat# x#))))+    countLeadingZeros (I16# w#) = CountOf $ wordToInt (W# (clz16# (int2Word# (int16ToIntCompat# w#))))+    countTrailingZeros (I16# w#) = CountOf $ wordToInt (W# (ctz16# (int2Word# (int16ToIntCompat# w#))))+instance BitOps Int16 where+    (I16# x#) .&. (I16# y#)   = I16# (intToInt16Compat# (int16ToIntCompat# x# `andI#` int16ToIntCompat# y#))+    (I16# x#) .|. (I16# y#)   = I16# (intToInt16Compat# (int16ToIntCompat# x# `orI#`  int16ToIntCompat# y#))+    (I16# x#) .^. (I16# y#)   = I16# (intToInt16Compat# (int16ToIntCompat# x# `xorI#` int16ToIntCompat# y#))+    (I16# x#) .<<. (CountOf (I# i#)) = I16# (narrow16IntCompat# (int16ToIntCompat# x# `iShiftL#`  i#))+    (I16# x#) .>>. (CountOf (I# i#)) = I16# (narrow16IntCompat# (int16ToIntCompat# x# `iShiftRL#` i#))++-- Int32 ----------------------------------------------------------------------++instance FiniteBitsOps Int32 where+    numberOfBits _ = 32+    rotateL (I32# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I32# x#+        | otherwise  = I32# (narrow32IntCompat# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`+                                                      (x'# `uncheckedShiftRL#` (32# -# i'#)))))+      where+        !x'# = narrow32Word# (int2Word# (int32ToIntCompat# x#))+        !i'# = word2Int# (int2Word# i# `and#` 31##)+    rotateR (I32# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I32# x#+        | otherwise  = I32# (narrow32IntCompat# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`+                                                      (x'# `uncheckedShiftL#` (32# -# i'#)))))+      where+        !x'# = narrow32Word# (int2Word# (int32ToIntCompat# x#))+        !i'# = word2Int# (int2Word# i# `and#` 31##)+    bitFlip (I32# x#) = I32# (intToInt32Compat# (word2Int# (not# (int2Word# (int32ToIntCompat# x#)))))+    popCount (I32# x#) = CountOf $ wordToInt (W# (popCnt32# (int2Word# (int32ToIntCompat# x#))))+    countLeadingZeros (I32# w#) = CountOf $ wordToInt (W# (clz32# (int2Word# (int32ToIntCompat# w#))))+    countTrailingZeros (I32# w#) = CountOf $ wordToInt (W# (ctz32# (int2Word# (int32ToIntCompat# w#))))+instance BitOps Int32 where+    (I32# x#) .&. (I32# y#)   = I32# (intToInt32Compat# (int32ToIntCompat# x# `andI#` int32ToIntCompat# y#))+    (I32# x#) .|. (I32# y#)   = I32# (intToInt32Compat# (int32ToIntCompat# x# `orI#`  int32ToIntCompat# y#))+    (I32# x#) .^. (I32# y#)   = I32# (intToInt32Compat# (int32ToIntCompat# x# `xorI#` int32ToIntCompat# y#))+    (I32# x#) .<<. (CountOf (I# i#)) = I32# (narrow32IntCompat# (int32ToIntCompat# x# `iShiftL#`  i#))+    (I32# x#) .>>. (CountOf (I# i#)) = I32# (narrow32IntCompat# (int32ToIntCompat# x# `iShiftRL#` i#))++-- Int64 ----------------------------------------------------------------------++#if WORD_SIZE_IN_BITS == 64+instance FiniteBitsOps Int64 where+    numberOfBits _ = 64+    rotateL (I64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I64# x#+        | otherwise  = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`+                                        (x'# `uncheckedShiftRL#` (64# -# i'#))))+      where+        !x'# = int2Word# x#+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    rotateR (I64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I64# x#+        | otherwise  = I64# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`+                                        (x'# `uncheckedShiftL#` (64# -# i'#))))+      where+        !x'# = int2Word# x#+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    bitFlip (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))+    popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int2Word# x#)))+    countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int2Word# w#)))+    countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int2Word# w#)))+instance BitOps Int64 where+    (I64# x#) .&. (I64# y#)   = I64# (x# `andI#` y#)+    (I64# x#) .|. (I64# y#)   = I64# (x# `orI#`  y#)+    (I64# x#) .^. (I64# y#)   = I64# (x# `xorI#` y#)+    (I64# x#) .<<. (CountOf (I# w#)) = I64# (x# `iShiftL#`  w#)+    (I64# x#) .>>. (CountOf (I# w#)) = I64# (x# `iShiftRL#` w#)+#else+instance FiniteBitsOps Int64 where+    numberOfBits _ = 64+    rotateL (I64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I64# x#+        | otherwise  = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`+                                             (x'# `uncheckedShiftRL64#` (64# -# i'#))))+      where+        !x'# = int64ToWord64# x#+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    rotateR (I64# x#) (CountOf (I# i#))+        | isTrue# (i'# ==# 0#) = I64# x#+        | otherwise  = I64# (word64ToInt64# ((x'# `uncheckedShiftRL64#` i'#) `or64#`+                                             (x'# `uncheckedShiftL64#` (64# -# i'#))))+      where+        !x'# = int64ToWord64# x#+        !i'# = word2Int# (int2Word# i# `and#` 63##)+    bitFlip (I64# x#) = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))+    popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int64ToWord64# x#)))+    countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int64ToWord64# w#)))+    countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int64ToWord64# w#)))+instance BitOps Int64 where+    (I64# x#) .&. (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))+    (I64# x#) .|. (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `or64#`  int64ToWord64# y#))+    (I64# x#) .^. (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))+    (I64# x#) .<<. (CountOf (I# w#)) = I64# (x# `iShiftL64#`  w#)+    (I64# x#) .>>. (CountOf (I# w#)) = I64# (x# `iShiftRA64#` w#)+++iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#+a `iShiftL64#` b  | isTrue# (b >=# 64#) = intToInt64# 0#+                  | otherwise           = a `uncheckedIShiftL64#` b+a `iShiftRA64#` b | isTrue# (b >=# 64#) && isTrue# (a `ltInt64#` (intToInt64# 0#))+                                        = intToInt64# (-1#)+                  | isTrue# (b >=# 64#) = intToInt64# 0#+                  | otherwise = a `uncheckedIShiftRA64#` b++#endif
+ Basement/Block.hs view
@@ -0,0 +1,441 @@+-- |+-- Module      : Basement.Block+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- A block of memory that contains elements of a type,+-- very similar to an unboxed array but with the key difference:+--+-- * It doesn't have slicing capability (no cheap take or drop)+-- * It consume less memory: 1 Offset, 1 CountOf+-- * It's unpackable in any constructor+-- * It uses unpinned memory by default+--+{-# LANGUAGE MagicHash           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples       #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Basement.Block+    ( Block(..)+    , MutableBlock(..)+    -- * Properties+    , length+    -- * Lowlevel functions+    , unsafeThaw+    , unsafeFreeze+    , unsafeIndex+    , thaw+    , freeze+    , copy+    , unsafeCast+    , cast+    -- * safer api+    , empty+    , create+    , isPinned+    , isMutablePinned+    , singleton+    , replicate+    , index+    , map+    , foldl'+    , foldr+    , foldl1'+    , foldr1+    , cons+    , snoc+    , uncons+    , unsnoc+    , sub+    , splitAt+    , revSplitAt+    , splitOn+    , break+    , breakEnd+    , span+    , elem+    , all+    , any+    , find+    , filter+    , reverse+    , sortBy+    , intersperse+    -- * Foreign interfaces+    , createFromPtr+    , unsafeCopyToPtr+    , withPtr+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.ST+import qualified Data.List+import           Basement.Compat.Base+import           Data.Proxy+import           Basement.Compat.Primitive+import           Basement.NonEmpty+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.Exception+import           Basement.PrimType+import qualified Basement.Block.Mutable as M+import           Basement.Block.Mutable (Block(..), MutableBlock(..), new, unsafeThaw, unsafeFreeze)+import           Basement.Block.Base+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.Numerical.Multiplicative+import qualified Basement.Alg.Mutable as MutAlg+import qualified Basement.Alg.Class as Alg+import qualified Basement.Alg.PrimArray as Alg++instance (PrimMonad prim, st ~ PrimState prim, PrimType ty) +         => Alg.RandomAccess (MutableBlock ty st) prim ty where+    read (MutableBlock mba) = primMbaRead mba+    write (MutableBlock mba) = primMbaWrite mba++instance (PrimType ty) => Alg.Indexable (Block ty) ty where+    index (Block ba) = primBaIndex ba+    {-# INLINE index #-}++instance Alg.Indexable (Block Word8) Word64 where+    index (Block ba) = primBaIndex ba+    {-# INLINE index #-}++-- | Copy all the block content to the memory starting at the destination address+unsafeCopyToPtr :: forall ty prim . PrimMonad prim+                => Block ty -- ^ the source block to copy+                -> Ptr ty   -- ^ The destination address where the copy is going to start+                -> prim ()+unsafeCopyToPtr (Block blk) (Ptr p) = primitive $ \s1 ->+    (# copyByteArrayToAddr# blk 0# p (sizeofByteArray# blk) s1, () #)++-- | Create a new array of size @n by settings each cells through the+-- function @f.+create :: forall ty . PrimType ty+       => CountOf ty           -- ^ the size of the block (in element of ty)+       -> (Offset ty -> ty) -- ^ the function that set the value at the index+       -> Block ty          -- ^ the array created+create n initializer+    | n == 0    = mempty+    | otherwise = runST $ do+        mb <- new n+        M.iterSet initializer mb+        unsafeFreeze mb++-- | Freeze a chunk of memory pointed, of specific size into a new unboxed array+createFromPtr :: PrimType ty+              => Ptr ty+              -> CountOf ty+              -> IO (Block ty)+createFromPtr p sz = do+    mb <- new sz+    M.copyFromPtr p mb 0 sz+    unsafeFreeze mb++singleton :: PrimType ty => ty -> Block ty+singleton ty = create 1 (const ty)++replicate :: PrimType ty => CountOf ty -> ty -> Block ty+replicate sz ty = create sz (const ty)++-- | Thaw a Block into a MutableBlock+--+-- the Block is not modified, instead a new Mutable Block is created+-- and its content is copied to the mutable block+thaw :: (PrimMonad prim, PrimType ty) => Block ty -> prim (MutableBlock ty (PrimState prim))+thaw array = do+    ma <- M.unsafeNew Unpinned (lengthBytes array)+    M.unsafeCopyBytesRO ma 0 array 0 (lengthBytes array)+    pure ma+{-# INLINE thaw #-}++-- | Freeze a MutableBlock into a Block, copying all the data+--+-- If the data is modified in the mutable block after this call, then+-- the immutable Block resulting is not impacted.+freeze :: (PrimType ty, PrimMonad prim) => MutableBlock ty (PrimState prim) -> prim (Block ty)+freeze ma = do+    ma' <- unsafeNew Unpinned len+    M.unsafeCopyBytes ma' 0 ma 0 len+    --M.copyAt ma' (Offset 0) ma (Offset 0) len+    unsafeFreeze ma'+  where+    len = M.mutableLengthBytes ma++-- | Copy every cells of an existing Block to a new Block+copy :: PrimType ty => Block ty -> Block ty+copy array = runST (thaw array >>= unsafeFreeze)++-- | Return the element at a specific index from an array.+--+-- If the index @n is out of bounds, an error is raised.+index :: PrimType ty => Block ty -> Offset ty -> ty+index array n+    | isOutOfBound n len = outOfBound OOB_Index n len+    | otherwise          = unsafeIndex array n+  where+    !len = length array+{-# INLINE index #-}++-- | Map all element 'a' from a block to a new block of 'b'+map :: (PrimType a, PrimType b) => (a -> b) -> Block a -> Block b+map f a = create lenB (\i -> f $ unsafeIndex a (offsetCast Proxy i))+  where !lenB = sizeCast (Proxy :: Proxy (a -> b)) (length a)++foldr :: PrimType ty => (ty -> a -> a) -> a -> Block ty -> a+foldr f initialAcc vec = loop 0+  where+    !len = length vec+    loop !i+        | i .==# len = initialAcc+        | otherwise  = unsafeIndex vec i `f` loop (i+1)+{-# SPECIALIZE [2] foldr :: (Word8 -> a -> a) -> a -> Block Word8 -> a #-}++foldl' :: PrimType ty => (a -> ty -> a) -> a -> Block ty -> a+foldl' f initialAcc vec = loop 0 initialAcc+  where+    !len = length vec+    loop !i !acc+        | i .==# len = acc+        | otherwise  = loop (i+1) (f acc (unsafeIndex vec i))+{-# SPECIALIZE [2] foldl' :: (a -> Word8 -> a) -> a -> Block Word8 -> a #-}++foldl1' :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty+foldl1' f (NonEmpty arr) = loop 1 (unsafeIndex arr 0)+  where+    !len = length arr+    loop !i !acc+        | i .==# len = acc+        | otherwise  = loop (i+1) (f acc (unsafeIndex arr i))+{-# SPECIALIZE [3] foldl1' :: (Word8 -> Word8 -> Word8) -> NonEmpty (Block Word8) -> Word8 #-}++foldr1 :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty+foldr1 f arr = let (initialAcc, rest) = revSplitAt 1 $ getNonEmpty arr+               in foldr f (unsafeIndex initialAcc 0) rest++cons :: PrimType ty => ty -> Block ty -> Block ty+cons e vec+    | len == 0  = singleton e+    | otherwise = runST $ do+        muv <- new (len + 1)+        M.unsafeCopyElementsRO muv 1 vec 0 len+        M.unsafeWrite muv 0 e+        unsafeFreeze muv+  where+    !len = length vec++snoc :: PrimType ty => Block ty -> ty -> Block ty+snoc vec e+    | len == 0  = singleton e+    | otherwise = runST $ do+        muv <- new (len + 1)+        M.unsafeCopyElementsRO muv 0 vec 0 len+        M.unsafeWrite muv (0 `offsetPlusE` len) e+        unsafeFreeze muv+  where+     !len = length vec++sub :: PrimType ty => Block ty -> Offset ty -> Offset ty -> Block ty+sub blk start end+    | start >= end' = mempty+    | otherwise     = runST $ do+        dst <- new newLen+        M.unsafeCopyElementsRO dst 0 blk start newLen+        unsafeFreeze dst+  where+    newLen = end' - start+    end' = min (sizeAsOffset len) end+    !len = length blk++uncons :: PrimType ty => Block ty -> Maybe (ty, Block ty)+uncons vec+    | nbElems == 0 = Nothing+    | otherwise    = Just (unsafeIndex vec 0, sub vec 1 (0 `offsetPlusE` nbElems))+  where+    !nbElems = length vec++unsnoc :: PrimType ty => Block ty -> Maybe (Block ty, ty)+unsnoc vec = case length vec - 1 of+    Nothing -> Nothing+    Just offset -> Just (sub vec 0 lastElem, unsafeIndex vec lastElem)+                     where !lastElem = 0 `offsetPlusE` offset++splitAt :: PrimType ty => CountOf ty -> Block ty -> (Block ty, Block ty)+splitAt nbElems blk+    | nbElems <= 0 = (mempty, blk)+    | Just nbTails <- length blk - nbElems, nbTails > 0 = runST $ do+        left  <- new nbElems+        right <- new nbTails+        M.unsafeCopyElementsRO left  0 blk 0                      nbElems+        M.unsafeCopyElementsRO right 0 blk (sizeAsOffset nbElems) nbTails+        (,) <$> unsafeFreeze left <*> unsafeFreeze right+    | otherwise    = (blk, mempty)+{-# SPECIALIZE [2] splitAt :: CountOf Word8 -> Block Word8 -> (Block Word8, Block Word8) #-}++revSplitAt :: PrimType ty => CountOf ty -> Block ty -> (Block ty, Block ty)+revSplitAt n blk +    | n <= 0                         = (mempty, blk)+    | Just nbElems <- length blk - n = let (x, y) = splitAt nbElems blk in (y, x)+    | otherwise                      = (blk, mempty)++break :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)+break predicate blk = findBreak 0+  where+    !len = length blk+    findBreak !i+        | i .==# len                    = (blk, mempty)+        | predicate (unsafeIndex blk i) = splitAt (offsetAsSize i) blk+        | otherwise                     = findBreak (i + 1)+    {-# INLINE findBreak #-}+{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> Block Word8 -> (Block Word8, Block Word8) #-}++breakEnd :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)+breakEnd predicate blk+    | k == sentinel = (blk, mempty)+    | otherwise     = splitAt (offsetAsSize (k+1)) blk+  where+    !k = Alg.revFindIndexPredicate predicate blk 0 end+    !end = sizeAsOffset $ length blk+{-# SPECIALIZE [2] breakEnd :: (Word8 -> Bool) -> Block Word8 -> (Block Word8, Block Word8) #-}++span :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)+span p = break (not . p)++elem :: PrimType ty => ty -> Block ty -> Bool+elem v blk = loop 0+  where+    !len = length blk+    loop !i+        | i .==# len             = False+        | unsafeIndex blk i == v = True+        | otherwise              = loop (i+1)+{-# SPECIALIZE [2] elem :: Word8 -> Block Word8 -> Bool #-}++all :: PrimType ty => (ty -> Bool) -> Block ty -> Bool+all p blk = loop 0+  where+    !len = length blk+    loop !i+        | i .==# len            = True+        | p (unsafeIndex blk i) = loop (i+1)+        | otherwise             = False+{-# SPECIALIZE [2] all :: (Word8 -> Bool) -> Block Word8 -> Bool #-}++any :: PrimType ty => (ty -> Bool) -> Block ty -> Bool+any p blk = loop 0+  where+    !len = length blk+    loop !i+        | i .==# len            = False+        | p (unsafeIndex blk i) = True+        | otherwise             = loop (i+1)+{-# SPECIALIZE [2] any :: (Word8 -> Bool) -> Block Word8 -> Bool #-}++splitOn :: PrimType ty => (ty -> Bool) -> Block ty -> [Block ty]+splitOn predicate blk+    | len == 0  = [mempty]+    | otherwise = go 0 0+  where+    !len = length blk+    go !prevIdx !idx+        | idx .==# len = [sub blk prevIdx idx]+        | otherwise    =+            let e = unsafeIndex blk idx+                idx' = idx + 1+             in if predicate e+                    then sub blk prevIdx idx : go idx' idx'+                    else go prevIdx idx'++find :: PrimType ty => (ty -> Bool) -> Block ty -> Maybe ty+find predicate vec = loop 0+  where+    !len = length vec+    loop i+        | i .==# len = Nothing+        | otherwise  =+            let e = unsafeIndex vec i+             in if predicate e then Just e else loop (i+1)++filter :: PrimType ty => (ty -> Bool) -> Block ty -> Block ty+filter predicate vec = fromList $ Data.List.filter predicate $ toList vec++reverse :: forall ty . PrimType ty => Block ty -> Block ty+reverse blk+    | len == 0  = mempty+    | otherwise = runST $ do+        mb <- new len+        go mb+        unsafeFreeze mb+  where+    !len = length blk+    !endOfs = 0 `offsetPlusE` len++    go :: MutableBlock ty s -> ST s ()+    go mb = loop endOfs 0+      where+        loop o i+            | i .==# len = pure ()+            | otherwise  = unsafeWrite mb o' (unsafeIndex blk i) >> loop o' (i+1)+          where o' = pred o++sortBy :: PrimType ty => (ty -> ty -> Ordering) -> Block ty -> Block ty+sortBy ford vec+    | len == 0  = mempty+    | otherwise = runST $ do+        mblock <- thaw vec+        MutAlg.inplaceSortBy ford 0 len mblock+        unsafeFreeze mblock+  where len = length vec+{-# SPECIALIZE [2] sortBy :: (Word8 -> Word8 -> Ordering) -> Block Word8 -> Block Word8 #-}++intersperse :: forall ty . PrimType ty => ty -> Block ty -> Block ty+intersperse sep blk = case len - 1 of+    Nothing -> blk+    Just 0 -> blk+    Just size -> runST $ do+        mb <- new (len+size)+        go mb+        unsafeFreeze mb+  where+    !len = length blk++    go :: MutableBlock ty s -> ST s ()+    go mb = loop 0 0+      where+        loop !o !i+            | (i + 1) .==# len = unsafeWrite mb o (unsafeIndex blk i)+            | otherwise        = do+                unsafeWrite mb o     (unsafeIndex blk i)+                unsafeWrite mb (o+1) sep+                loop (o+2) (i+1)++-- | Unsafely recast an UArray containing 'a' to an UArray containing 'b'+--+-- The offset and size are converted from units of 'a' to units of 'b',+-- but no check are performed to make sure this is compatible.+--+-- use 'cast' if unsure.+unsafeCast :: PrimType b => Block a -> Block b+unsafeCast (Block ba) = Block ba++-- | Cast a Block of 'a' to a Block of 'b'+--+-- The requirement is that the size of type 'a' need to be a multiple or+-- dividend of the size of type 'b'.+--+-- If this requirement is not met, the InvalidRecast exception is thrown+cast :: forall a b . (PrimType a, PrimType b) => Block a -> Block b+cast blk@(Block ba)+    | aTypeSize == bTypeSize || bTypeSize == 1 = unsafeCast blk+    | missing   == 0                           = unsafeCast blk+    | otherwise                                =+        throw $ InvalidRecast (RecastSourceSize alen) (RecastDestinationSize $ alen + missing)+  where+    (CountOf alen) = lengthBytes blk++    aTypeSize = primSizeInBytes (Proxy :: Proxy a)+    bTypeSize@(CountOf bs) = primSizeInBytes (Proxy :: Proxy b)++    missing = alen `mod` bs
+ Basement/Block/Base.hs view
@@ -0,0 +1,489 @@+{-# LANGUAGE MagicHash           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples       #-}+module Basement.Block.Base+    ( Block(..)+    , MutableBlock(..)+    -- * Basic accessor+    , unsafeNew+    , unsafeThaw+    , unsafeFreeze+    , unsafeShrink+    , unsafeCopyElements+    , unsafeCopyElementsRO+    , unsafeCopyBytes+    , unsafeCopyBytesRO+    , unsafeCopyBytesPtr+    , unsafeRead+    , unsafeWrite+    , unsafeIndex+    -- * Properties+    , length+    , lengthBytes+    , isPinned+    , isMutablePinned+    , mutableLength+    , mutableLengthBytes+    -- * Other methods+    , empty+    , mutableEmpty+    , new+    , newPinned+    , withPtr+    , withMutablePtr+    , withMutablePtrHint+    , mutableWithPtr+    , unsafeRecast+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.ST+import           GHC.IO+import qualified Data.List+import           Basement.Compat.Base+import           Data.Proxy+import           Basement.Compat.Primitive+import           Basement.Compat.Semigroup+import           Basement.Bindings.Memory (sysHsMemcmpBaBa)+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.NormalForm+import           Basement.Numerical.Additive+import           Basement.PrimType++-- | A block of memory containing unpacked bytes representing values of type 'ty'+data Block ty = Block ByteArray#+    deriving (Typeable)++unsafeBlockPtr :: Block ty -> Ptr ty+unsafeBlockPtr (Block arrBa) = Ptr (byteArrayContents# arrBa)+{-# INLINE unsafeBlockPtr #-}++instance Data ty => Data (Block ty) where+    dataTypeOf _ = blockType+    toConstr _   = error "toConstr"+    gunfold _ _  = error "gunfold"++blockType :: DataType+blockType = mkNoRepType "Basement.Block"++instance NormalForm (Block ty) where+    toNormalForm (Block !_) = ()+instance (PrimType ty, Show ty) => Show (Block ty) where+    show v = show (toList v)+instance (PrimType ty, Eq ty) => Eq (Block ty) where+    {-# SPECIALIZE instance Eq (Block Word8) #-}+    (==) = equal+instance (PrimType ty, Ord ty) => Ord (Block ty) where+    compare = internalCompare++instance PrimType ty => Semigroup (Block ty) where+    (<>) = append+instance PrimType ty => Monoid (Block ty) where+    mempty  = empty+    mappend = append+    mconcat = concat++instance PrimType ty => IsList (Block ty) where+    type Item (Block ty) = ty+    fromList = internalFromList+    toList = internalToList++-- | A Mutable block of memory containing unpacked bytes representing values of type 'ty'+data MutableBlock ty st = MutableBlock (MutableByteArray# st)++isPinned :: Block ty -> PinnedStatus+isPinned (Block ba) = toPinnedStatus# (compatIsByteArrayPinned# ba)++isMutablePinned :: MutableBlock s ty -> PinnedStatus+isMutablePinned (MutableBlock mba) = toPinnedStatus# (compatIsMutableByteArrayPinned# mba)++length :: forall ty . PrimType ty => Block ty -> CountOf ty+length (Block ba) =+    case primShiftToBytes (Proxy :: Proxy ty) of+        0           -> CountOf (I# (sizeofByteArray# ba))+        (I# szBits) -> CountOf (I# (uncheckedIShiftRL# (sizeofByteArray# ba) szBits))+{-# INLINE[1] length #-}+{-# SPECIALIZE [2] length :: Block Word8 -> CountOf Word8 #-}++lengthBytes :: Block ty -> CountOf Word8+lengthBytes (Block ba) = CountOf (I# (sizeofByteArray# ba))+{-# INLINE[1] lengthBytes #-}++-- | Return the length of a Mutable Block+--+-- note: we don't allow resizing yet, so this can remain a pure function+mutableLength :: forall ty st . PrimType ty => MutableBlock ty st -> CountOf ty+mutableLength mb = sizeRecast $ mutableLengthBytes mb+{-# INLINE[1] mutableLength #-}++mutableLengthBytes :: MutableBlock ty st -> CountOf Word8+mutableLengthBytes (MutableBlock mba) = CountOf (I# (sizeofMutableByteArray# mba))+{-# INLINE[1] mutableLengthBytes #-}++-- | Create an empty block of memory+empty :: Block ty+empty = Block ba where !(Block ba) = empty_++empty_ :: Block ()+empty_ = runST $ primitive $ \s1 ->+    case newByteArray# 0# s1           of { (# s2, mba #) ->+    case unsafeFreezeByteArray# mba s2 of { (# s3, ba  #) ->+        (# s3, Block ba #) }}++mutableEmpty :: PrimMonad prim => prim (MutableBlock ty (PrimState prim))+mutableEmpty = primitive $ \s1 ->+    case newByteArray# 0# s1 of { (# s2, mba #) ->+        (# s2, MutableBlock mba #) }++-- | Return the element at a specific index from an array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'index' if unsure.+unsafeIndex :: forall ty . PrimType ty => Block ty -> Offset ty -> ty+unsafeIndex (Block ba) n = primBaIndex ba n+{-# SPECIALIZE unsafeIndex :: Block Word8 -> Offset Word8 -> Word8 #-}+{-# INLINE unsafeIndex #-}++-- | make a block from a list of elements.+internalFromList :: PrimType ty => [ty] -> Block ty+internalFromList l = runST $ do+    ma <- new (CountOf len)+    iter azero l $ \i x -> unsafeWrite ma i x+    unsafeFreeze ma+  where+    !len = Data.List.length l++    iter _  []     _ = return ()+    iter !i (x:xs) z = z i x >> iter (i+1) xs z++-- | transform a block to a list.+internalToList :: forall ty . PrimType ty => Block ty -> [ty]+internalToList blk@(Block ba)+    | len == azero = []+    | otherwise    = loop azero+  where+    !len = length blk+    loop !i | i .==# len = []+            | otherwise  = primBaIndex ba i : loop (i+1)++-- | Check if two blocks are identical+equal :: (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool+equal a b+    | la /= lb  = False+    | otherwise = loop azero+  where+    !la = lengthBytes a+    !lb = lengthBytes b+    lat = length a++    loop !n | n .==# lat = True+            | otherwise  = (unsafeIndex a n == unsafeIndex b n) && loop (n+o1)+    o1 = Offset (I# 1#)+{-# RULES "Block/Eq/Word8" [3]+   forall (a :: Block Word8) b . equal a b = equalMemcmp a b #-}+{-# INLINEABLE [2] equal #-}+-- {-# SPECIALIZE equal :: Block Word8 -> Block Word8 -> Bool #-}++equalMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Bool+equalMemcmp b1@(Block a) b2@(Block b)+    | la /= lb  = False+    | otherwise = unsafeDupablePerformIO (sysHsMemcmpBaBa a 0 b 0 la) == 0+  where+    la = lengthBytes b1+    lb = lengthBytes b2+{-# SPECIALIZE equalMemcmp :: Block Word8 -> Block Word8 -> Bool #-}++-- | Compare 2 blocks+internalCompare :: (Ord ty, PrimType ty) => Block ty -> Block ty -> Ordering+internalCompare a b = loop azero+  where+    !la = length a+    !lb = length b+    !end = sizeAsOffset (min la lb)+    loop !n+        | n == end  = la `compare` lb+        | v1 == v2  = loop (n + Offset (I# 1#))+        | otherwise = v1 `compare` v2+      where+        v1 = unsafeIndex a n+        v2 = unsafeIndex b n+{-# RULES "Block/Ord/Word8" [3] forall (a :: Block Word8) b . internalCompare a b = compareMemcmp a b #-}+{-# NOINLINE internalCompare #-}++compareMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Ordering+compareMemcmp b1@(Block a) b2@(Block b) =+    case unsafeDupablePerformIO (sysHsMemcmpBaBa a 0 b 0 sz) of+        0             -> la `compare` lb+        n | n > 0     -> GT+          | otherwise -> LT+  where+    la = lengthBytes b1+    lb = lengthBytes b2+    sz = min la lb+{-# SPECIALIZE [3] compareMemcmp :: Block Word8 -> Block Word8 -> Ordering #-}++-- | Append 2 blocks together by creating a new bigger block+append :: Block ty -> Block ty -> Block ty+append a b+    | la == azero = b+    | lb == azero = a+    | otherwise = runST $ do+        r  <- unsafeNew Unpinned (la+lb)+        unsafeCopyBytesRO r 0                 a 0 la+        unsafeCopyBytesRO r (sizeAsOffset la) b 0 lb+        unsafeFreeze r+  where+    !la = lengthBytes a+    !lb = lengthBytes b++concat :: forall ty . [Block ty] -> Block ty+concat original = runST $ do+    r <- unsafeNew Unpinned total+    goCopy r zero original+    unsafeFreeze r+  where+    !total = size 0 original+    -- size+    size !sz []     = sz+    size !sz (x:xs) = size (lengthBytes x + sz) xs++    zero = Offset 0++    goCopy r = loop+      where+        loop _  []      = pure ()+        loop !i (x:xs) = do+            unsafeCopyBytesRO r i x zero lx+            loop (i `offsetPlusE` lx) xs+          where !lx = lengthBytes x++-- | Freeze a mutable block into a block.+--+-- If the mutable block is still use after freeze,+-- then the modification will be reflected in an unexpected+-- way in the Block.+unsafeFreeze :: PrimMonad prim => MutableBlock ty (PrimState prim) -> prim (Block ty)+unsafeFreeze (MutableBlock mba) = primitive $ \s1 ->+    case unsafeFreezeByteArray# mba s1 of+        (# s2, ba #) -> (# s2, Block ba #)+{-# INLINE unsafeFreeze #-}++unsafeShrink :: PrimMonad prim => MutableBlock ty (PrimState prim) -> CountOf ty -> prim (MutableBlock ty (PrimState prim))+unsafeShrink (MutableBlock mba) (CountOf (I# nsz)) = primitive $ \s ->+    case shrinkMutableByteArray# mba nsz s of+        s -> (# s, MutableBlock mba #)++-- | Thaw an immutable block.+--+-- If the immutable block is modified, then the original immutable block will+-- be modified too, but lead to unexpected results when querying+unsafeThaw :: (PrimType ty, PrimMonad prim) => Block ty -> prim (MutableBlock ty (PrimState prim))+unsafeThaw (Block ba) = primitive $ \st -> (# st, MutableBlock (unsafeCoerce# ba) #)++-- | Create a new mutable block of a specific size in bytes.+--+-- Note that no checks are made to see if the size in bytes is compatible with the size+-- of the underlaying element 'ty' in the block.+--+-- use 'new' if unsure+unsafeNew :: PrimMonad prim+          => PinnedStatus+          -> CountOf Word8+          -> prim (MutableBlock ty (PrimState prim))+unsafeNew pinSt (CountOf (I# bytes)) = case pinSt of+    Unpinned -> primitive $ \s1 -> case newByteArray# bytes s1 of { (# s2, mba #) -> (# s2, MutableBlock mba #) }+    _        -> primitive $ \s1 -> case newAlignedPinnedByteArray# bytes 8# s1 of { (# s2, mba #) -> (# s2, MutableBlock mba #) }++-- | Create a new unpinned mutable block of a specific N size of 'ty' elements+--+-- If the size exceeds a GHC-defined threshold, then the memory will be+-- pinned. To be certain about pinning status with small size, use 'newPinned'+new :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))+new n = unsafeNew Unpinned (sizeOfE (primSizeInBytes (Proxy :: Proxy ty)) n)++-- | Create a new pinned mutable block of a specific N size of 'ty' elements+newPinned :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))+newPinned n = unsafeNew Pinned (sizeOfE (primSizeInBytes (Proxy :: Proxy ty)) n)++-- | Copy a number of elements from an array to another array with offsets+unsafeCopyElements :: forall prim ty . (PrimMonad prim, PrimType ty)+                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block+                   -> Offset ty                        -- ^ offset at destination+                   -> MutableBlock ty (PrimState prim) -- ^ source mutable block+                   -> Offset ty                        -- ^ offset at source+                   -> CountOf ty                          -- ^ number of elements to copy+                   -> prim ()+unsafeCopyElements dstMb destOffset srcMb srcOffset n = -- (MutableBlock dstMba) ed (MutableBlock srcBa) es n =+    unsafeCopyBytes dstMb (offsetOfE sz destOffset)+                    srcMb (offsetOfE sz srcOffset)+                    (sizeOfE sz n)+  where+    !sz = primSizeInBytes (Proxy :: Proxy ty)++unsafeCopyElementsRO :: forall prim ty . (PrimMonad prim, PrimType ty)+                     => MutableBlock ty (PrimState prim) -- ^ destination mutable block+                     -> Offset ty                        -- ^ offset at destination+                     -> Block ty                         -- ^ source block+                     -> Offset ty                        -- ^ offset at source+                     -> CountOf ty                          -- ^ number of elements to copy+                     -> prim ()+unsafeCopyElementsRO dstMb destOffset srcMb srcOffset n =+    unsafeCopyBytesRO dstMb (offsetOfE sz destOffset)+                      srcMb (offsetOfE sz srcOffset)+                      (sizeOfE sz n)+  where+    !sz = primSizeInBytes (Proxy :: Proxy ty)++-- | Copy a number of bytes from a MutableBlock to another MutableBlock with specific byte offsets+unsafeCopyBytes :: forall prim ty . PrimMonad prim+                => MutableBlock ty (PrimState prim) -- ^ destination mutable block+                -> Offset Word8                     -- ^ offset at destination+                -> MutableBlock ty (PrimState prim) -- ^ source mutable block+                -> Offset Word8                     -- ^ offset at source+                -> CountOf Word8                       -- ^ number of elements to copy+                -> prim ()+unsafeCopyBytes (MutableBlock dstMba) (Offset (I# d)) (MutableBlock srcBa) (Offset (I# s)) (CountOf (I# n)) =+    primitive $ \st -> (# copyMutableByteArray# srcBa s dstMba d n st, () #)+{-# INLINE unsafeCopyBytes #-}++-- | Copy a number of bytes from a Block to a MutableBlock with specific byte offsets+unsafeCopyBytesRO :: forall prim ty . PrimMonad prim+                  => MutableBlock ty (PrimState prim) -- ^ destination mutable block+                  -> Offset Word8                     -- ^ offset at destination+                  -> Block ty                         -- ^ source block+                  -> Offset Word8                     -- ^ offset at source+                  -> CountOf Word8                       -- ^ number of elements to copy+                  -> prim ()+unsafeCopyBytesRO (MutableBlock dstMba) (Offset (I# d)) (Block srcBa) (Offset (I# s)) (CountOf (I# n)) =+    primitive $ \st -> (# copyByteArray# srcBa s dstMba d n st, () #)+{-# INLINE unsafeCopyBytesRO #-}++-- | Copy a number of bytes from a Ptr to a MutableBlock with specific byte offsets+unsafeCopyBytesPtr :: forall prim ty . PrimMonad prim+                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block+                   -> Offset Word8                     -- ^ offset at destination+                   -> Ptr ty                           -- ^ source block+                   -> CountOf Word8                    -- ^ number of bytes to copy+                   -> prim ()+unsafeCopyBytesPtr (MutableBlock dstMba) (Offset (I# d)) (Ptr srcBa) (CountOf (I# n)) =+    primitive $ \st -> (# copyAddrToByteArray# srcBa dstMba d n st, () #)+{-# INLINE unsafeCopyBytesPtr #-}++-- | read from a cell in a mutable block without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'read' if unsure.+unsafeRead :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty+unsafeRead (MutableBlock mba) i = primMbaRead mba i+{-# INLINE unsafeRead #-}++-- | write to a cell in a mutable block without bounds checking.+--+-- Writing with invalid bounds will corrupt memory and your program will+-- become unreliable. use 'write' if unsure.+unsafeWrite :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()+unsafeWrite (MutableBlock mba) i v = primMbaWrite mba i v+{-# INLINE unsafeWrite #-}++-- | Get a Ptr pointing to the data in the Block.+--+-- Since a Block is immutable, this Ptr shouldn't be+-- to use to modify the contents+--+-- If the Block is pinned, then its address is returned as is,+-- however if it's unpinned, a pinned copy of the Block is made+-- before getting the address.+withPtr :: PrimMonad prim+        => Block ty+        -> (Ptr ty -> prim a)+        -> prim a+withPtr x@(Block ba) f+    | isPinned x == Pinned = f (Ptr (byteArrayContents# ba)) <* touch x+    | otherwise            = do+        arr <- makeTrampoline+        f (unsafeBlockPtr arr) <* touch arr+  where+    makeTrampoline = do+        trampoline <- unsafeNew Pinned (lengthBytes x)+        unsafeCopyBytesRO trampoline 0 x 0 (lengthBytes x)+        unsafeFreeze trampoline++touch :: PrimMonad prim => Block ty -> prim ()+touch (Block ba) =+    unsafePrimFromIO $ primitive $ \s -> case touch# ba s of { s2 -> (# s2, () #) }++unsafeRecast :: (PrimType t1, PrimType t2)+             => MutableBlock t1 st+             -> MutableBlock t2 st+unsafeRecast (MutableBlock mba) = MutableBlock mba++-- | Use the 'Ptr' to a mutable block in a safer construct+--+-- If the block is not pinned, this is a _dangerous_ operation+mutableWithPtr :: PrimMonad prim+                => MutableBlock ty (PrimState prim)+                -> (Ptr ty -> prim a)+                -> prim a+mutableWithPtr = withMutablePtr+{-# DEPRECATED mutableWithPtr "use withMutablePtr" #-}++-- | Create a pointer on the beginning of the MutableBlock+-- and call a function 'f'.+--+-- The mutable block can be mutated by the 'f' function+-- and the change will be reflected in the mutable block+--+-- If the mutable block is unpinned, a trampoline buffer+-- is created and the data is only copied when 'f' return.+--+-- it is all-in-all highly inefficient as this cause 2 copies+withMutablePtr :: PrimMonad prim+               => MutableBlock ty (PrimState prim)+               -> (Ptr ty -> prim a)+               -> prim a+withMutablePtr = withMutablePtrHint False False+++-- | Same as 'withMutablePtr' but allow to specify 2 optimisations+-- which is only useful when the MutableBlock is unpinned and need+-- a pinned trampoline to be called safely.+--+-- If skipCopy is True, then the first copy which happen before+-- the call to 'f', is skipped. The Ptr is now effectively+-- pointing to uninitialized data in a new mutable Block.+--+-- If skipCopyBack is True, then the second copy which happen after+-- the call to 'f', is skipped. Then effectively in the case of a+-- trampoline being used the memory changed by 'f' will not+-- be reflected in the original Mutable Block.+--+-- If using the wrong parameters, it will lead to difficult to+-- debug issue of corrupted buffer which only present themselves+-- with certain Mutable Block that happened to have been allocated+-- unpinned.+--+-- If unsure use 'withMutablePtr', which default to *not* skip+-- any copy.+withMutablePtrHint :: forall ty prim a . PrimMonad prim+                   => Bool -- ^ hint that the buffer doesn't need to have the same value as the mutable block when calling f+                   -> Bool -- ^ hint that the buffer is not supposed to be modified by call of f+                   -> MutableBlock ty (PrimState prim)+                   -> (Ptr ty -> prim a)+                   -> prim a+withMutablePtrHint skipCopy skipCopyBack mb f+    | isMutablePinned mb == Pinned = callWithPtr mb+    | otherwise                    = do+        trampoline <- unsafeNew Pinned vecSz+        unless skipCopy $+            unsafeCopyBytes trampoline 0 mb 0 vecSz+        r <- callWithPtr trampoline+        unless skipCopyBack $+            unsafeCopyBytes mb 0 trampoline 0 vecSz+        pure r+  where+    vecSz = mutableLengthBytes mb+    callWithPtr pinnedMb = do+        b <- unsafeFreeze pinnedMb+        f (unsafeBlockPtr b) <* touch b
+ Basement/Block/Builder.hs view
@@ -0,0 +1,151 @@+-- |+-- Module      : Basement.Block.Builder+-- License     : BSD-style+-- Maintainer  : Foundation+--+-- Block builder++{-# LANGUAGE Rank2Types #-}++module Basement.Block.Builder+    ( Builder+    , run++    -- * Emit functions+    , emit+    , emitPrim+    , emitString+    , emitUTF8Char++    -- * unsafe+    , unsafeRunString+    ) where++import qualified Basement.Alg.UTF8 as UTF8+import           Basement.UTF8.Helper          (charToBytes)+import           Basement.Numerical.Conversion (charToInt)+import           Basement.Block.Base (Block(..), MutableBlock(..))+import qualified Basement.Block.Base as B+import           Basement.Cast+import           Basement.Compat.Base+import           Basement.Compat.Semigroup+import           Basement.Monad+import           Basement.FinalPtr (FinalPtr, withFinalPtr)+import           Basement.Numerical.Additive+import           Basement.String                (String(..))+import qualified Basement.String as S+import           Basement.Types.OffsetSize+import           Basement.PrimType (PrimType(..), primMbaWrite)+import           Basement.UArray.Base (UArray(..))+import qualified Basement.UArray.Base as A++import           GHC.ST+import           Data.Proxy++newtype Action = Action+    { runAction_ :: forall prim . PrimMonad prim+                 => MutableBlock Word8 (PrimState prim)+                 -> Offset Word8+                 -> prim (Offset Word8)+    }++data Builder = Builder {-# UNPACK #-} !(CountOf Word8)+                                      !Action++instance Semigroup Builder where+    (<>) = append+    {-# INLINABLE (<>) #-}+instance Monoid Builder where+    mempty = empty+    {-# INLINE mempty #-}+    mappend = append+    {-# INLINABLE mappend #-}+    mconcat = concat+    {-# INLINABLE mconcat #-}++-- | create an empty builder+--+-- this does nothing, build nothing, take no space (in the resulted block)+empty :: Builder+empty = Builder 0 (Action $ \_ !off -> pure off)+{-# INLINE empty #-}++-- | concatenate the 2 given bulider+append :: Builder -> Builder -> Builder+append (Builder size1 (Action action1)) (Builder size2 (Action action2)) =+    Builder size action+  where+    action = Action $ \arr off -> do+      off' <- action1 arr off+      action2 arr off'+    size = size1 + size2+{-# INLINABLE append #-}++-- | concatenate the list of builder+concat :: [Builder] -> Builder+concat = loop 0 (Action $ \_ !off -> pure off)+  where+    loop !sz acc          []                              = Builder sz acc+    loop !sz (Action acc) (Builder !s (Action action):xs) =+       loop (sz + s) (Action $ \arr off -> acc arr off >>= action arr) xs+{-# INLINABLE concat #-}++-- | run the given builder and return the generated block+run :: PrimMonad prim => Builder -> prim (Block Word8)+run (Builder sz action) = do+    mb <- B.new sz+    off <- runAction_ action mb 0+    B.unsafeShrink mb (offsetAsSize off) >>= B.unsafeFreeze++-- | run the given builder and return a UTF8String+--+-- this action is unsafe as there is no guarantee upon the validity of the+-- content of the built block.+unsafeRunString :: PrimMonad prim => Builder -> prim String+unsafeRunString b = do+    str <- run b+    pure $ String $ A.UArray 0 (B.length str) (A.UArrayBA str)++-- | add a Block in the builder+emit :: Block a -> Builder+emit b = Builder size $ Action $ \arr off ->+    B.unsafeCopyBytesRO arr off b' 0 size *> pure (off + sizeAsOffset size)+  where+    b' :: Block Word8+    b' = cast b+    size :: CountOf Word8+    size = B.length b'++emitPrim :: (PrimType ty, ty ~ Word8) => ty -> Builder+emitPrim a = Builder size $ Action $ \(MutableBlock arr) off ->+    primMbaWrite arr off a *> pure (off + sizeAsOffset size)+  where+    size = getSize Proxy a+    getSize :: PrimType ty => Proxy ty -> ty -> CountOf Word8+    getSize p _ = primSizeInBytes p++-- | add a string in the builder+emitString :: String -> Builder+emitString (String str) = Builder size $ Action $ \arr off ->+    A.onBackendPrim (onBA arr off) (onAddr arr off) str *> pure (off + sizeAsOffset size)+  where+    size = A.length str+    onBA :: PrimMonad prim+         => MutableBlock Word8 (PrimState prim)+         -> Offset Word8+         -> Block Word8+         -> prim ()+    onBA   arr off ba   = B.unsafeCopyBytesRO arr off ba 0 size+    onAddr :: PrimMonad prim+           => MutableBlock Word8 (PrimState prim)+           -> Offset Word8+           -> FinalPtr Word8+           -> prim ()+    onAddr arr off fptr = withFinalPtr fptr $ \ptr -> B.unsafeCopyBytesPtr arr off ptr size++-- | emit a UTF8 char in the builder+--+-- this function may be replaced by `emit :: Encoding -> Char -> Builder`+emitUTF8Char :: Char -> Builder+emitUTF8Char c = Builder (charToBytes $ charToInt c) $ Action $ \block@(MutableBlock !_) off ->+    UTF8.writeUTF8 block off c
+ Basement/Block/Mutable.hs view
@@ -0,0 +1,154 @@+-- |+-- Module      : Basement.Block.Mutable+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- A block of memory that contains elements of a type,+-- very similar to an unboxed array but with the key difference:+--+-- * It doesn't have slicing capability (no cheap take or drop)+-- * It consume less memory: 1 Offset, 1 CountOf, 1 Pinning status trimmed+-- * It's unpackable in any constructor+-- * It uses unpinned memory by default+--+-- It should be rarely needed in high level API, but+-- in lowlevel API or some data structure containing lots+-- of unboxed array that will benefit from optimisation.+--+-- Because it's unpinned, the blocks are compactable / movable,+-- at the expense of making them less friendly to interop with the C layer+-- as address.+--+-- Note that sadly the bytearray primitive type automatically create+-- a pinned bytearray if the size is bigger than a certain threshold+--+-- GHC Documentation associated:+--+-- includes/rts/storage/Block.h+--   * LARGE_OBJECT_THRESHOLD ((uint32_t)(BLOCK_SIZE * 8 / 10))+--   * BLOCK_SIZE   (1<<BLOCK_SHIFT)+--+-- includes/rts/Constant.h+--   * BLOCK_SHIFT  12+--+{-# LANGUAGE MagicHash           #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnboxedTuples       #-}+module Basement.Block.Mutable+    ( Block(..)+    , MutableBlock(..)+    , mutableLengthSize+    , mutableLength+    , mutableLengthBytes+    , mutableWithPtr+    , withMutablePtr+    , withMutablePtrHint+    , new+    , newPinned+    , mutableEmpty+    , iterSet+    , read+    , write+    , unsafeNew+    , unsafeWrite+    , unsafeRead+    , unsafeFreeze+    , unsafeThaw+    , unsafeCopyElements+    , unsafeCopyElementsRO+    , unsafeCopyBytes+    , unsafeCopyBytesRO+    , unsafeCopyBytesPtr+    -- * Foreign+    , copyFromPtr+    , copyToPtr+    ) where++import           GHC.Prim+import           GHC.Types+import           Basement.Compat.Base+import           Data.Proxy+import           Basement.Exception+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.Numerical.Additive+import           Basement.PrimType+import           Basement.Block.Base++-- | Set all mutable block element to a value+iterSet :: (PrimType ty, PrimMonad prim)+        => (Offset ty -> ty)+        -> MutableBlock ty (PrimState prim)+        -> prim ()+iterSet f ma = loop 0+  where+    !sz = mutableLength ma+    loop i+        | i .==# sz = pure ()+        | otherwise = unsafeWrite ma i (f i) >> loop (i+1)+    {-# INLINE loop #-}++mutableLengthSize :: PrimType ty => MutableBlock ty st -> CountOf ty+mutableLengthSize = mutableLength+{-# DEPRECATED mutableLengthSize "use mutableLength" #-}++-- | read a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+read :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty+read array n+    | isOutOfBound n len = primOutOfBound OOB_Read n len+    | otherwise          = unsafeRead array n+  where len = mutableLength array+{-# INLINE read #-}++-- | Write to a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+write :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()+write array n val+    | isOutOfBound n len = primOutOfBound OOB_Write n len+    | otherwise          = unsafeWrite array n val+  where+    len = mutableLengthSize array+{-# INLINE write #-}++-- | Copy from a pointer, @count@ elements, into the Mutable Block at a starting offset @ofs@+--+-- if the source pointer is invalid (size or bad allocation), bad things will happen+--+copyFromPtr :: forall prim ty . (PrimMonad prim, PrimType ty)+            => Ptr ty                           -- ^ Source Ptr of 'ty' to start of memory+            -> MutableBlock ty (PrimState prim) -- ^ Destination mutable block+            -> Offset ty                        -- ^ Start offset in the destination mutable block+            -> CountOf ty                       -- ^ Number of 'ty' elements+            -> prim ()+copyFromPtr src@(Ptr src#) mb@(MutableBlock mba) ofs count+    | end > sizeAsOffset arrSz = primOutOfBound OOB_MemCopy end arrSz+    | otherwise                = primitive $ \st -> (# copyAddrToByteArray# src# mba od# bytes# st, () #)+  where+    end = od `offsetPlusE` arrSz++    sz = primSizeInBytes (Proxy :: Proxy ty)+    !arrSz@(CountOf (I# bytes#)) = sizeOfE sz count+    !od@(Offset (I# od#)) = offsetOfE sz ofs++-- | Copy all the block content to the memory starting at the destination address+--+-- If the destination pointer is invalid (size or bad allocation), bad things will happen+copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)+          => MutableBlock ty (PrimState prim) -- ^ The source mutable block to copy+          -> Offset ty                        -- ^ The source offset in the mutable block+          -> Ptr ty                           -- ^ The destination address where the copy is going to start+          -> CountOf ty                       -- ^ The number of bytes+          -> prim ()+copyToPtr mb@(MutableBlock mba) ofs dst@(Ptr dst#) count+    | srcEnd > sizeAsOffset arrSz = primOutOfBound OOB_MemCopy srcEnd arrSz+    | otherwise                = do+        blk <- unsafeFreeze mb+        let !(Block ba) = blk+        primitive $ \s1 -> (# copyByteArrayToAddr# ba os# dst# szBytes# s1, () #)+  where+    srcEnd = os `offsetPlusE` arrSz+    !os@(Offset (I# os#)) = offsetInBytes ofs+    !arrSz@(CountOf (I# szBytes#)) = mutableLengthBytes mb
+ Basement/BlockN.hs view
@@ -0,0 +1,10 @@+-- |+-- Module      : Basement.Block+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- A Nat-sized version of Block++module Basement.BlockN (module X) where++import Basement.Sized.Block as X
+ Basement/Bounded.hs view
@@ -0,0 +1,125 @@+-- |+-- Module      : Basement.Block+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- Types to represent ℤ/nℤ.+--+-- ℤ/nℤ is a finite field and is defined as the set of natural number:+-- {0, 1, ..., n − 1}.+--+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+module Basement.Bounded+    ( Zn64+    , unZn64+    , Zn+    , unZn+    , zn64+    , zn+    , zn64Nat+    , znNat+    ) where++import           GHC.TypeLits+import           Data.Word+import           Basement.Compat.Base+import           Basement.Compat.Natural+import           Basement.Numerical.Number+import           Data.Proxy+import           Basement.Nat+import qualified Prelude++-- | A type level bounded natural backed by a Word64+newtype Zn64 (n :: Nat) = Zn64 { unZn64 :: Word64 }+    deriving (Show,Eq,Ord)++instance (KnownNat n, NatWithinBound Word64 n) => Prelude.Num (Zn64 n) where+    fromInteger = zn64 . Prelude.fromInteger+    (+) = add64+    (-) = sub64+    (*) = mul64+    abs a = a+    negate _ = error "cannot negate Zn64: use Foundation Numerical hierarchy for this function to not be exposed to Zn64"+    signum (Zn64 a) = Zn64 (Prelude.signum a)++type instance NatNumMaxBound (Zn64 n) = n++instance (KnownNat n, NatWithinBound Word64 n) => Integral (Zn64 n) where+    fromInteger = zn64 . Prelude.fromInteger+instance (KnownNat n, NatWithinBound Word64 n) => IsIntegral (Zn64 n) where+    toInteger (Zn64 n) = toInteger n+instance (KnownNat n, NatWithinBound Word64 n) => IsNatural (Zn64 (n :: Nat)) where+    toNatural (Zn64 n) = toNatural n++-- | Create an element of ℤ/nℤ from a Word64+--+-- If the value is greater than n, then the value is normalized by using the+-- integer modulus n+zn64 :: forall n . (KnownNat n, NatWithinBound Word64 n) => Word64 -> Zn64 n+zn64 v = Zn64 (v `Prelude.mod` natValWord64 (Proxy :: Proxy n))++-- | Create an element of ℤ/nℤ from a type level Nat+zn64Nat :: forall m n . (KnownNat m, KnownNat n, NatWithinBound Word64 m, NatWithinBound Word64 n, CmpNat m n ~ 'LT)+        => Proxy m+        -> Zn64 n+zn64Nat p = Zn64 (natValWord64 p)++-- | Add 2 Zn64+add64 :: forall n . (KnownNat n, NatWithinBound Word64 n) => Zn64 n -> Zn64 n -> Zn64 n+add64 (Zn64 a) (Zn64 b) = Zn64 ((a Prelude.+ b) `Prelude.mod` natValWord64 (Proxy :: Proxy n))++-- | subtract 2 Zn64+sub64 :: forall n . (KnownNat n, NatWithinBound Word64 n) => Zn64 n -> Zn64 n -> Zn64 n+sub64 (Zn64 a) (Zn64 b) = Zn64 ((a Prelude.- b) `Prelude.mod` natValWord64 (Proxy :: Proxy n))++-- | Multiply 2 Zn64+mul64 :: forall n . (KnownNat n, NatWithinBound Word64 n) => Zn64 n -> Zn64 n -> Zn64 n+mul64 (Zn64 a) (Zn64 b) = Zn64 ((a Prelude.* b) `Prelude.mod` natValWord64 (Proxy :: Proxy n))++-- | A type level bounded natural+newtype Zn (n :: Nat) = Zn { unZn :: Natural }+    deriving (Show,Eq,Ord)++instance KnownNat n => Prelude.Num (Zn n) where+    fromInteger = zn . Prelude.fromInteger+    (+) = add+    (-) = sub+    (*) = mul+    abs a = a+    negate _ = error "cannot negate Zn: use Foundation Numerical hierarchy for this function to not be exposed to Zn"+    signum = Zn . Prelude.signum . unZn++type instance NatNumMaxBound (Zn n) = n++instance KnownNat n => Integral (Zn n) where+    fromInteger = zn . Prelude.fromInteger+instance KnownNat n => IsIntegral (Zn n) where+    toInteger (Zn n) = toInteger n+instance KnownNat n => IsNatural (Zn n) where+    toNatural i = unZn i++-- | Create an element of ℤ/nℤ from a Natural.+--+-- If the value is greater than n, then the value is normalized by using the+-- integer modulus n+zn :: forall n . KnownNat n => Natural -> Zn n+zn v = Zn (v `Prelude.mod` natValNatural (Proxy :: Proxy n))++-- | Create an element of ℤ/nℤ from a type level Nat+znNat :: forall m n . (KnownNat m, KnownNat n, CmpNat m n ~ 'LT) => Proxy m -> Zn n+znNat m = Zn (natValNatural m)++-- | Add 2 Zn+add :: forall n . KnownNat n => Zn n -> Zn n -> Zn n+add (Zn a) (Zn b) = Zn ((a Prelude.+ b) `Prelude.mod` natValNatural (Proxy :: Proxy n))++-- | subtract 2 Zn+sub :: forall n . KnownNat n => Zn n -> Zn n -> Zn n+sub (Zn a) (Zn b) = Zn ((a Prelude.- b) `Prelude.mod` natValNatural (Proxy :: Proxy n))++-- | Multiply 2 Zn+mul :: forall n . KnownNat n => Zn n -> Zn n -> Zn n+mul (Zn a) (Zn b) = Zn ((a Prelude.* b) `Prelude.mod` natValNatural (Proxy :: Proxy n))+
+ Basement/BoxedArray.hs view
@@ -0,0 +1,776 @@+-- |+-- Module      : Basement.BoxedArray+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Simple boxed array abstraction+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Basement.BoxedArray+    ( Array+    , MArray+    , empty+    , length+    , mutableLength+    , copy+    , unsafeCopyAtRO+    , thaw+    , new+    , create+    , unsafeFreeze+    , unsafeThaw+    , freeze+    , unsafeWrite+    , unsafeRead+    , unsafeIndex+    , write+    , read+    , index+    , singleton+    , replicate+    , null+    , take+    , drop+    , splitAt+    , revTake+    , revDrop+    , revSplitAt+    , splitOn+    , sub+    , intersperse+    , span+    , spanEnd+    , break+    , breakEnd+    , mapFromUnboxed+    , mapToUnboxed+    , cons+    , snoc+    , uncons+    , unsnoc+    -- , findIndex+    , sortBy+    , filter+    , reverse+    , elem+    , find+    , foldl'+    , foldr+    , foldl1'+    , foldr1+    , all+    , any+    , isPrefixOf+    , isSuffixOf+    , builderAppend+    , builderBuild+    , builderBuild_+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.ST+import           Data.Proxy+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.NonEmpty+import           Basement.Compat.Base+import qualified Basement.Alg.Class as Alg+import qualified Basement.Alg.Mutable as Alg+import           Basement.Compat.MonadTrans+import           Basement.Compat.Semigroup+import           Basement.Compat.Primitive+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.NormalForm+import           Basement.Monad+import           Basement.UArray.Base (UArray)+import qualified Basement.UArray.Base as UArray+import           Basement.Exception+import           Basement.MutableBuilder+import qualified Basement.Compat.ExtList as List++-- | Array of a+data Array a = Array {-# UNPACK #-} !(Offset a)+                     {-# UNPACK #-} !(CountOf a)+                                    (Array# a)+    deriving (Typeable)++instance Data ty => Data (Array ty) where+    dataTypeOf _ = arrayType+    toConstr _   = error "toConstr"+    gunfold _ _  = error "gunfold"++arrayType :: DataType+arrayType = mkNoRepType "Foundation.Array"++instance NormalForm a => NormalForm (Array a) where+    toNormalForm arr = loop 0+      where+        !sz = length arr+        loop !i+            | i .==# sz = ()+            | otherwise = unsafeIndex arr i `seq` loop (i+1)++-- | Mutable Array of a+data MArray a st = MArray {-# UNPACK #-} !(Offset a)+                          {-# UNPACK #-} !(CountOf a)+                                         (MutableArray# st a)+    deriving (Typeable)++instance Functor Array where+    fmap = map++instance Semigroup (Array a) where+    (<>) = append+instance Monoid (Array a) where+    mempty  = empty+    mappend = append+    mconcat = concat++instance Show a => Show (Array a) where+    show v = show (toList v)++instance Eq a => Eq (Array a) where+    (==) = equal+instance Ord a => Ord (Array a) where+    compare = vCompare++instance IsList (Array ty) where+    type Item (Array ty) = ty+    fromList = vFromList+    fromListN len = vFromListN (CountOf len)+    toList = vToList++-- | return the numbers of elements in a mutable array+mutableLength :: MArray ty st -> Int+mutableLength (MArray _ (CountOf len) _) = len+{-# INLINE mutableLength #-}++-- | return the numbers of elements in a mutable array+mutableLengthSize :: MArray ty st -> CountOf ty+mutableLengthSize (MArray _ size _) = size+{-# INLINE mutableLengthSize #-}++-- | Return the element at a specific index from an array.+--+-- If the index @n is out of bounds, an error is raised.+index :: Array ty -> Offset ty -> ty+index array n+    | isOutOfBound n len = outOfBound OOB_Index n len+    | otherwise          = unsafeIndex array n+  where len = length array+{-# INLINE index #-}++-- | Return the element at a specific index from an array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'index' if unsure.+unsafeIndex :: Array ty -> Offset ty -> ty+unsafeIndex (Array start _ a) ofs = primArrayIndex a (start+ofs)+{-# INLINE unsafeIndex #-}++-- | read a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+read :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim ty+read array n+    | isOutOfBound n len = primOutOfBound OOB_Read n len+    | otherwise          = unsafeRead array n+  where len = mutableLengthSize array+{-# INLINE read #-}++-- | read from a cell in a mutable array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'read' if unsure.+unsafeRead :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim ty+unsafeRead (MArray start _ ma) i = primMutableArrayRead ma (start + i)+{-# INLINE unsafeRead #-}++-- | Write to a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+write :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> ty -> prim ()+write array n val+    | isOutOfBound n len = primOutOfBound OOB_Write n len+    | otherwise          = unsafeWrite array n val+  where len = mutableLengthSize array+{-# INLINE write #-}++-- | write to a cell in a mutable array without bounds checking.+--+-- Writing with invalid bounds will corrupt memory and your program will+-- become unreliable. use 'write' if unsure.+unsafeWrite :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> ty -> prim ()+unsafeWrite (MArray start _ ma) ofs v =+    primMutableArrayWrite ma (start + ofs) v+{-# INLINE unsafeWrite #-}++-- | Freeze a mutable array into an array.+--+-- the MArray must not be changed after freezing.+unsafeFreeze :: PrimMonad prim => MArray ty (PrimState prim) -> prim (Array ty)+unsafeFreeze (MArray ofs sz ma) = primitive $ \s1 ->+    case unsafeFreezeArray# ma s1 of+        (# s2, a #) -> (# s2, Array ofs sz a #)+{-# INLINE unsafeFreeze #-}++-- | Thaw an immutable array.+--+-- The Array must not be used after thawing.+unsafeThaw :: PrimMonad prim => Array ty -> prim (MArray ty (PrimState prim))+unsafeThaw (Array ofs sz a) = primitive $ \st -> (# st, MArray ofs sz (unsafeCoerce# a) #)+{-# INLINE unsafeThaw #-}++-- | Thaw an array to a mutable array.+--+-- the array is not modified, instead a new mutable array is created+-- and every values is copied, before returning the mutable array.+thaw :: PrimMonad prim => Array ty -> prim (MArray ty (PrimState prim))+thaw array = do+    m <- new (length array)+    unsafeCopyAtRO m (Offset 0) array (Offset 0) (length array)+    pure m+{-# INLINE thaw #-}++freeze :: PrimMonad prim => MArray ty (PrimState prim) -> prim (Array ty)+freeze marray = do+    m <- new sz+    copyAt m (Offset 0) marray (Offset 0) sz+    unsafeFreeze m+  where+    sz = mutableLengthSize marray++-- | Copy the element to a new element array+copy :: Array ty -> Array ty+copy a = runST (unsafeThaw a >>= freeze)++-- | Copy a number of elements from an array to another array with offsets+copyAt :: PrimMonad prim+       => MArray ty (PrimState prim) -- ^ destination array+       -> Offset ty                  -- ^ offset at destination+       -> MArray ty (PrimState prim) -- ^ source array+       -> Offset ty                  -- ^ offset at source+       -> CountOf ty                 -- ^ number of elements to copy+       -> prim ()+copyAt dst od src os n = loop od os+  where -- !endIndex = os `offsetPlusE` n+        loop d s+            | s .==# n  = pure ()+            | otherwise = unsafeRead src s >>= unsafeWrite dst d >> loop (d+1) (s+1)++-- | Copy @n@ sequential elements from the specified offset in a source array+--   to the specified position in a destination array.+--+--   This function does not check bounds. Accessing invalid memory can return+--   unpredictable and invalid values.+unsafeCopyAtRO :: PrimMonad prim+               => MArray ty (PrimState prim) -- ^ destination array+               -> Offset ty                  -- ^ offset at destination+               -> Array ty                   -- ^ source array+               -> Offset ty                  -- ^ offset at source+               -> CountOf ty                    -- ^ number of elements to copy+               -> prim ()+unsafeCopyAtRO (MArray (Offset (I# dstart)) _ da) (Offset (I# dofs))+               (Array  (Offset (I# sstart)) _ sa) (Offset (I# sofs))+               (CountOf (I# n)) =+    primitive $ \st ->+        (# copyArray# sa (sstart +# sofs) da (dstart +# dofs) n st, () #)++-- | Allocate a new array with a fill function that has access to the elements of+--   the source array.+unsafeCopyFrom :: Array ty -- ^ Source array+               -> CountOf ty  -- ^ Length of the destination array+               -> (Array ty -> Offset ty -> MArray ty s -> ST s ())+               -- ^ Function called for each element in the source array+               -> ST s (Array ty) -- ^ Returns the filled new array+unsafeCopyFrom v' newLen f = new newLen >>= fill (Offset 0) f >>= unsafeFreeze+  where len = length v'+        endIdx = Offset 0 `offsetPlusE` len+        fill i f' r'+            | i == endIdx = pure r'+            | otherwise   = do f' v' i r'+                               fill (i + Offset 1) f' r'++-- | Create a new mutable array of size @n.+--+-- all the cells are uninitialized and could contains invalid values.+--+-- All mutable arrays are allocated on a 64 bits aligned addresses+-- and always contains a number of bytes multiples of 64 bits.+new :: PrimMonad prim => CountOf ty -> prim (MArray ty (PrimState prim))+new sz@(CountOf (I# n)) = primitive $ \s1 ->+    case newArray# n (error "vector: internal error uninitialized vector") s1 of+        (# s2, ma #) -> (# s2, MArray (Offset 0) sz ma #)++-- | Create a new array of size @n by settings each cells through the+-- function @f.+create :: forall ty . CountOf ty -- ^ the size of the array+       -> (Offset ty -> ty)   -- ^ the function that set the value at the index+       -> Array ty            -- ^ the array created+create n initializer = runST (new n >>= iter initializer)+  where+    iter :: PrimMonad prim => (Offset ty -> ty) -> MArray ty (PrimState prim) -> prim (Array ty)+    iter f ma = loop 0+      where+        loop s+            | s .==# n  = unsafeFreeze ma+            | otherwise = unsafeWrite ma s (f s) >> loop (s+1)+        {-# INLINE loop #-}+    {-# INLINE iter #-}++-----------------------------------------------------------------------+-- higher level collection implementation+-----------------------------------------------------------------------+equal :: Eq a => Array a -> Array a -> Bool+equal a b = (len == length b) && eachEqual 0+  where+    len = length a+    eachEqual !i+        | i .==# len                         = True+        | unsafeIndex a i /= unsafeIndex b i = False+        | otherwise                          = eachEqual (i+1)++vCompare :: Ord a => Array a -> Array a -> Ordering+vCompare a b = loop 0+  where+    !la = length a+    !lb = length b+    loop n+        | n .==# la = if la == lb then EQ else LT+        | n .==# lb = GT+        | otherwise =+            case unsafeIndex a n `compare` unsafeIndex b n of+                EQ -> loop (n+1)+                r  -> r++empty :: Array a+empty = runST $ onNewArray 0 (\_ s -> s)++length :: Array a -> CountOf a+length (Array _ sz _) = sz++vFromList :: [a] -> Array a+vFromList l = runST (new len >>= loop 0 l)+  where+    len = List.length l+    loop _ []     ma = unsafeFreeze ma+    loop i (x:xs) ma = unsafeWrite ma i x >> loop (i+1) xs ma++-- | just like vFromList but with a length hint.+--+-- The resulting array is guarantee to have been allocated to the length+-- specified, but the slice might point to the initialized cells only in+-- case the length is bigger than the list.+--+-- If the length is too small, then the list is truncated.+--+vFromListN :: forall a . CountOf a -> [a] -> Array a+vFromListN len l = runST $ do+    ma <- new len+    sz <- loop 0 l ma+    unsafeFreezeShrink ma sz+  where+    -- TODO rewrite without ma as parameter+    loop :: Offset a -> [a] -> MArray a s -> ST s (CountOf a)+    loop i []     _  = return (offsetAsSize i)+    loop i (x:xs) ma+        | i .==# len = return (offsetAsSize i)+        | otherwise  = unsafeWrite ma i x >> loop (i+1) xs ma++vToList :: Array a -> [a]+vToList v+    | len == 0  = []+    | otherwise = fmap (unsafeIndex v) [0..sizeLastOffset len]+  where !len = length v++-- | Append 2 arrays together by creating a new bigger array+append :: Array ty -> Array ty -> Array ty+append a b = runST $ do+    r  <- new (la+lb)+    unsafeCopyAtRO r (Offset 0) a (Offset 0) la+    unsafeCopyAtRO r (sizeAsOffset la) b (Offset 0) lb+    unsafeFreeze r+  where la = length a+        lb = length b++concat :: [Array ty] -> Array ty+concat l = runST $ do+    r <- new (mconcat $ fmap length l)+    loop r (Offset 0) l+    unsafeFreeze r+  where loop _ _ []     = pure ()+        loop r i (x:xs) = do+            unsafeCopyAtRO r i x (Offset 0) lx+            loop r (i `offsetPlusE` lx) xs+          where lx = length x++{-+modify :: PrimMonad m+       => Array a+       -> (MArray (PrimState m) a -> m ())+       -> m (Array a)+modify (Array a) f = primitive $ \st -> do+    case thawArray# a 0# (sizeofArray# a) st of+        (# st2, mv #) ->+            case internal_ (f $ MArray mv) st2 of+                st3 ->+                    case unsafeFreezeArray# mv st3 of+                        (# st4, a' #) -> (# st4, Array a' #)+-}++-----------------------------------------------------------------------+-- helpers++onNewArray :: PrimMonad m+           => Int+           -> (MutableArray# (PrimState m) a -> State# (PrimState m) -> State# (PrimState m))+           -> m (Array a)+onNewArray len@(I# len#) f = primitive $ \st -> do+    case newArray# len# (error "onArray") st of { (# st2, mv #) ->+    case f mv st2                            of { st3           ->+    case unsafeFreezeArray# mv st3           of { (# st4, a #)  ->+        (# st4, Array (Offset 0) (CountOf len) a #) }}}++-----------------------------------------------------------------------+++null :: Array ty -> Bool+null = (==) 0 . length++take :: CountOf ty -> Array ty -> Array ty+take nbElems a@(Array start len arr)+    | nbElems <= 0 = empty+    | n == len     = a+    | otherwise    = Array start n arr+  where+    n = min nbElems len++drop :: CountOf ty -> Array ty -> Array ty+drop nbElems a@(Array start len arr)+    | nbElems <= 0                               = a+    | Just nbTails <- len - nbElems, nbTails > 0 = Array (start `offsetPlusE` nbElems) nbTails arr+    | otherwise                                  = empty++splitAt :: CountOf ty -> Array ty -> (Array ty, Array ty)+splitAt nbElems a@(Array start len arr)+    | nbElems <= 0 = (empty, a)+    | Just nbTails <- len - nbElems, nbTails > 0 = ( Array start                         nbElems arr+                                                   , Array (start `offsetPlusE` nbElems) nbTails arr)+    | otherwise = (a, empty)++-- inverse a CountOf that is specified from the end (e.g. take n elements from the end)+countFromStart :: Array ty -> CountOf ty -> CountOf ty+countFromStart v sz@(CountOf sz')+    | sz >= len = CountOf 0+    | otherwise = CountOf (len' - sz')+  where len@(CountOf len') = length v++revTake :: CountOf ty -> Array ty -> Array ty+revTake n v = drop (countFromStart v n) v++revDrop :: CountOf ty -> Array ty -> Array ty+revDrop n v = take (countFromStart v n) v++revSplitAt :: CountOf ty -> Array ty -> (Array ty, Array ty)+revSplitAt n v = (drop idx v, take idx v) where idx = countFromStart v n++splitOn ::  (ty -> Bool) -> Array ty -> [Array ty]+splitOn predicate vec+    | len == CountOf 0 = [mempty]+    | otherwise     = loop (Offset 0) (Offset 0)+  where+    !len = length vec+    !endIdx = Offset 0 `offsetPlusE` len+    loop prevIdx idx+        | idx == endIdx = [sub vec prevIdx idx]+        | otherwise     =+            let e = unsafeIndex vec idx+                idx' = idx + 1+             in if predicate e+                    then sub vec prevIdx idx : loop idx' idx'+                    else loop prevIdx idx'++sub :: Array ty -> Offset ty -> Offset ty -> Array ty+sub (Array start len a) startIdx expectedEndIdx+    | startIdx == endIdx           = empty+    | otherwise                    = Array (start + startIdx) newLen a+  where+    newLen = endIdx - startIdx+    endIdx = min expectedEndIdx (sizeAsOffset len)++break ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)+break predicate v = findBreak 0+  where+    !len = length v+    findBreak i+        | i .==# len  = (v, empty)+        | otherwise   =+            if predicate (unsafeIndex v i)+                then splitAt (offsetAsSize i) v+                else findBreak (i+1)++breakEnd ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)+breakEnd predicate v = findBreak (sizeAsOffset len)+  where+    !len = length v+    findBreak !i+        | i == 0      = (v, empty)+        | predicate e = splitAt (offsetAsSize i) v+        | otherwise   = findBreak i'+      where+        e = unsafeIndex v i'+        i' = i `offsetSub` 1++intersperse :: ty -> Array ty -> Array ty+intersperse sep v = case len - 1 of+    Nothing -> v+    Just 0 -> v+    Just more -> runST $ unsafeCopyFrom v (len + more) (go (Offset 0 `offsetPlusE` more) sep)+  where len = length v+        -- terminate 1 before the end++        go :: Offset ty -> ty -> Array ty -> Offset ty -> MArray ty s -> ST s ()+        go endI sep' oldV oldI newV+            | oldI == endI = unsafeWrite newV dst e+            | otherwise    = do+                unsafeWrite newV dst e+                unsafeWrite newV (dst + 1) sep'+          where+            e = unsafeIndex oldV oldI+            dst = oldI + oldI++span ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)+span p = break (not . p)++spanEnd ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)+spanEnd p = breakEnd (not . p)++map :: (a -> b) -> Array a -> Array b+map f a = create (sizeCast Proxy $ length a) (\i -> f $ unsafeIndex a (offsetCast Proxy i))++mapFromUnboxed :: PrimType a => (a -> b) -> UArray a -> Array b+mapFromUnboxed f arr = vFromListN (sizeCast Proxy $ UArray.length arr) . fmap f . toList $ arr++mapToUnboxed :: PrimType b => (a -> b) -> Array a -> UArray b+mapToUnboxed f arr = UArray.vFromListN (sizeCast Proxy $ length arr) . fmap f . toList $ arr++{-+mapIndex :: (Int -> a -> b) -> Array a -> Array b+mapIndex f a = create (length a) (\i -> f i $ unsafeIndex a i)+-}++singleton :: ty -> Array ty+singleton e = runST $ do+    a <- new 1+    unsafeWrite a 0 e+    unsafeFreeze a++replicate :: CountOf ty -> ty -> Array ty+replicate sz ty = create sz (const ty)++cons :: ty -> Array ty -> Array ty+cons e vec+    | len == CountOf 0 = singleton e+    | otherwise     = runST $ do+        mv <- new (len + CountOf 1)+        unsafeWrite mv 0 e+        unsafeCopyAtRO mv (Offset 1) vec (Offset 0) len+        unsafeFreeze mv+  where+    !len = length vec++snoc ::  Array ty -> ty -> Array ty+snoc vec e+    | len == 0  = singleton e+    | otherwise = runST $ do+        mv <- new (len + 1)+        unsafeCopyAtRO mv 0 vec 0 len+        unsafeWrite mv (sizeAsOffset len) e+        unsafeFreeze mv+  where+    !len = length vec++uncons :: Array ty -> Maybe (ty, Array ty)+uncons vec+    | len == 0  = Nothing+    | otherwise = Just (unsafeIndex vec 0, drop 1 vec)+  where+    !len = length vec++unsnoc :: Array ty -> Maybe (Array ty, ty)+unsnoc vec = case len - 1 of+    Nothing -> Nothing+    Just newLen -> Just (take newLen vec, unsafeIndex vec (sizeLastOffset len))+  where+    !len = length vec++elem :: Eq ty => ty -> Array ty -> Bool+elem !ty arr = loop 0+  where+    !sz = length arr+    loop !i | i .==# sz = False+            | t == ty   = True+            | otherwise = loop (i+1)+      where t = unsafeIndex arr i++find :: (ty -> Bool) -> Array ty -> Maybe ty+find predicate vec = loop 0+  where+    !len = length vec+    loop i+        | i .==# len = Nothing+        | otherwise  =+            let e = unsafeIndex vec i+             in if predicate e then Just e else loop (i+1)++instance (PrimMonad prim, st ~ PrimState prim) +         => Alg.RandomAccess (MArray ty st) prim ty where+    read (MArray _ _ mba) = primMutableArrayRead mba+    write (MArray _ _ mba) = primMutableArrayWrite mba++sortBy :: forall ty . (ty -> ty -> Ordering) -> Array ty -> Array ty+sortBy xford vec+    | len == 0  = empty+    | otherwise = runST (thaw vec >>= doSort xford)+  where+    len = length vec+    doSort :: PrimMonad prim => (ty -> ty -> Ordering) -> MArray ty (PrimState prim) -> prim (Array ty)+    doSort ford ma = Alg.inplaceSortBy ford 0 len ma >> unsafeFreeze ma++filter :: forall ty . (ty -> Bool) -> Array ty -> Array ty+filter predicate vec = runST (new len >>= copyFilterFreeze predicate (unsafeIndex vec))+  where+    !len = length vec+    copyFilterFreeze :: PrimMonad prim => (ty -> Bool) -> (Offset ty -> ty) -> MArray ty (PrimState prim) -> prim (Array ty)+    copyFilterFreeze predi getVec mvec = loop (Offset 0) (Offset 0) >>= freezeUntilIndex mvec+      where+        loop d s+            | s .==# len  = pure d+            | predi v     = unsafeWrite mvec d v >> loop (d+1) (s+1)+            | otherwise   = loop d (s+1)+          where+            v = getVec s++freezeUntilIndex :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim (Array ty)+freezeUntilIndex mvec d = do+    m <- new (offsetAsSize d)+    copyAt m (Offset 0) mvec (Offset 0) (offsetAsSize d)+    unsafeFreeze m++unsafeFreezeShrink :: PrimMonad prim => MArray ty (PrimState prim) -> CountOf ty -> prim (Array ty)+unsafeFreezeShrink (MArray start _ ma) n = unsafeFreeze (MArray start n ma)++reverse :: Array ty -> Array ty+reverse a = create len toEnd+  where+    len@(CountOf s) = length a+    toEnd (Offset i) = unsafeIndex a (Offset (s - 1 - i))++foldr :: (ty -> a -> a) -> a -> Array ty -> a+foldr f initialAcc vec = loop 0+  where+    len = length vec+    loop !i+        | i .==# len = initialAcc+        | otherwise  = unsafeIndex vec i `f` loop (i+1)++foldl' :: (a -> ty -> a) -> a -> Array ty -> a+foldl' f initialAcc vec = loop 0 initialAcc+  where+    len = length vec+    loop !i !acc+        | i .==# len = acc+        | otherwise  = loop (i+1) (f acc (unsafeIndex vec i))++foldl1' :: (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty+foldl1' f arr = let (initialAcc, rest) = splitAt 1 $ getNonEmpty arr+               in foldl' f (unsafeIndex initialAcc 0) rest++foldr1 :: (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty+foldr1 f arr = let (initialAcc, rest) = revSplitAt 1 $ getNonEmpty arr+               in foldr f (unsafeIndex initialAcc 0) rest++all :: (ty -> Bool) -> Array ty -> Bool+all p ba = loop 0+  where+    len = length ba+    loop !i+      | i .==# len = True+      | not $ p (unsafeIndex ba i) = False+      | otherwise = loop (i + 1)++any :: (ty -> Bool) -> Array ty -> Bool+any p ba = loop 0+  where+    len = length ba+    loop !i+      | i .==# len = False+      | p (unsafeIndex ba i) = True+      | otherwise = loop (i + 1)++isPrefixOf :: Eq ty => Array ty -> Array ty -> Bool+isPrefixOf pre arr+    | pLen > pArr = False+    | otherwise   = pre == take pLen arr+  where+    !pLen = length pre+    !pArr = length arr++isSuffixOf :: Eq ty => Array ty -> Array ty -> Bool+isSuffixOf suffix arr+    | pLen > pArr = False+    | otherwise   = suffix == revTake pLen arr+  where+    !pLen = length suffix+    !pArr = length arr++builderAppend :: PrimMonad state => ty -> Builder (Array ty) (MArray ty) ty state err ()+builderAppend v = Builder $ State $ \(i, st, e) ->+    if i .==# chunkSize st+        then do+            cur      <- unsafeFreeze (curChunk st)+            newChunk <- new (chunkSize st)+            unsafeWrite newChunk 0 v+            pure ((), (Offset 1, st { prevChunks     = cur : prevChunks st+                                      , prevChunksSize = chunkSize st + prevChunksSize st+                                      , curChunk       = newChunk+                                      }, e))+        else do+            unsafeWrite (curChunk st) i v+            pure ((), (i+1, st, e))++builderBuild :: PrimMonad m => Int -> Builder (Array ty) (MArray ty) ty m err () -> m (Either err (Array ty))+builderBuild sizeChunksI ab+    | sizeChunksI <= 0 = builderBuild 64 ab+    | otherwise        = do+        first      <- new sizeChunks+        (i, st, e) <- snd <$> runState (runBuilder ab) (Offset 0, BuildingState [] (CountOf 0) first sizeChunks, Nothing)+        case e of+          Just err -> pure (Left err)+          Nothing -> do+            cur <- unsafeFreezeShrink (curChunk st) (offsetAsSize i)+            -- Build final array+            let totalSize = prevChunksSize st + offsetAsSize i+            bytes <- new totalSize >>= fillFromEnd totalSize (cur : prevChunks st) >>= unsafeFreeze+            pure (Right bytes)+  where+    sizeChunks = CountOf sizeChunksI++    fillFromEnd _    []     mua = pure mua+    fillFromEnd !end (x:xs) mua = do+        let sz = length x+        let start = end `sizeSub` sz+        unsafeCopyAtRO mua (sizeAsOffset start) x (Offset 0) sz+        fillFromEnd start xs mua++builderBuild_ :: PrimMonad m => Int -> Builder (Array ty) (MArray ty) ty m () () -> m (Array ty)+builderBuild_ sizeChunksI ab = either (\() -> internalError "impossible output") id <$> builderBuild sizeChunksI ab
+ Basement/Cast.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- |+-- Module      : Basement.Cast+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+module Basement.Cast+    ( Cast(..)+    ) where++#include "MachDeps.h"++import qualified Basement.Block.Base as Block+import           Basement.Compat.Base+import           Basement.Compat.Natural+import           Basement.HeadHackageUtils+import           Basement.Numerical.Number+import           Basement.Numerical.Conversion+import           Basement.PrimType++import           Data.Proxy (Proxy(..))++import           GHC.Int+import           GHC.Prim+import           GHC.Types+import           GHC.ST+import           GHC.Word++-- | `Cast` an object of type a to b.+--+-- Do not add instance of this class if the source type is not of the same+-- size of the destination type. Also keep in mind this is casting a value+-- of a given type into a destination type. The value won't be changed to+-- fit the destination represention.+--+-- If you wish to convert a value of a given type into another type, look at+-- `From` and `TryFrom`.+--+-- @+-- cast (-10 :: Int) :: Word === 18446744073709551606+-- @+--+class Cast source destination where+    cast :: source -> destination++    default cast :: ( PrimType source+                    , PrimType destination+                    , PrimSize source ~ PrimSize destination+                    )+                 => source -> destination+    cast a = runST $ do+        mba <- Block.new 1+        Block.unsafeWrite mba 0 a+        Block.unsafeRead (Block.unsafeRecast mba) 0++instance Cast Int8  Word8 where+    cast (I8# i) = W8# (narrow8WordCompat# (int2Word# (int8ToIntCompat# i)))+instance Cast Int16 Word16 where+    cast (I16# i) = W16# (narrow16WordCompat# (int2Word# (int16ToIntCompat# i)))+instance Cast Int32 Word32 where+    cast (I32# i) = W32# (narrow32WordCompat# (int2Word# (int32ToIntCompat# i)))+instance Cast Int64 Word64 where+    cast = int64ToWord64+instance Cast Int   Word where+    cast (I# i) = W# (int2Word# i)++instance Cast Word8  Int8 where+    cast (W8# i) = I8# (narrow8IntCompat# (word2Int# (word8ToWordCompat# i)))+instance Cast Word16 Int16 where+    cast (W16# i) = I16# (narrow16IntCompat# (word2Int# (word16ToWordCompat# i)))+instance Cast Word32 Int32 where+    cast (W32# i) = I32# (narrow32IntCompat# (word2Int# (word32ToWordCompat# i)))+instance Cast Word64 Int64 where+    cast = word64ToInt64+instance Cast Word   Int where+    cast (W# w) = I# (word2Int# w)++#if WORD_SIZE_IN_BITS == 64+instance Cast Word   Word64 where+    cast (W# w) = W64# w+instance Cast Word64 Word where+    cast (W64# w) = W# w++instance Cast Word   Int64 where+    cast (W# w) = I64# (word2Int# w)+instance Cast Int64  Word where+    cast (I64# i) = W# (int2Word# i)++instance Cast Int    Int64 where+    cast (I# i) = I64# i+instance Cast Int64  Int where+    cast (I64# i) = I# i++instance Cast Int    Word64 where+    cast (I# i) = W64# (int2Word# i)+instance Cast Word64 Int where+    cast (W64# w) = I# (word2Int# w)+#else+instance Cast Word   Word32 where+    cast (W# w) = W32# w+instance Cast Word32 Word where+    cast (W32# w) = W# w++instance Cast Word   Int32 where+    cast (W# w) = I32# (word2Int# w)+instance Cast Int32  Word where+    cast (I32# i) = W# (int2Word# i)++instance Cast Int    Int32 where+    cast (I# i) = I32# i+instance Cast Int32  Int where+    cast (I32# i) = I# i++instance Cast Int    Word32 where+    cast (I# i) = W32# (int2Word# i)+instance Cast Word32 Int where+    cast (W32# w) = I# (word2Int# w)+#endif++instance Cast (Block.Block a) (Block.Block Word8) where+    cast (Block.Block ba) = Block.Block ba
+ Basement/Compat/AMP.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE ConstraintKinds #-}+-- a compat module for ghc < 7.10 to handle the AMP change smoothly+module Basement.Compat.AMP+    ( AMPMonad+    ) where++import Basement.Compat.Base++{-# DEPRECATED AMPMonad "use Monad" #-}+type AMPMonad m = Monad m
+ Basement/Compat/Base.hs view
@@ -0,0 +1,94 @@+-- |+-- Module      : Basement.Compat.Base+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- internal re-export of all the good base bits+module Basement.Compat.Base+    ( (Prelude.$)+    , (Prelude.$!)+    , (Prelude.&&)+    , (Prelude.||)+    , (Control.Category..)+    , (Control.Applicative.<$>)+    , Prelude.not+    , Prelude.otherwise+    , Prelude.fst+    , Prelude.snd+    , Control.Category.id+    , Prelude.maybe+    , Prelude.either+    , Prelude.flip+    , Prelude.const+    , Prelude.error+    , Prelude.and+    , Prelude.undefined+    , Prelude.seq+    , Prelude.Show (..)+    , Prelude.Ord (..)+    , Prelude.Eq (..)+    , Prelude.Bounded (..)+    , Prelude.Enum (..)+    , Prelude.Functor (..)+    , Control.Applicative.Applicative (..)+    , Prelude.Monad (..)+    , Control.Monad.when+    , Control.Monad.unless+    , Prelude.Maybe (..)+    , Prelude.Ordering (..)+    , Prelude.Bool (..)+    , Prelude.Int+    , Prelude.Integer+    , Prelude.Char+    , Basement.Compat.NumLiteral.Integral (..)+    , Basement.Compat.NumLiteral.Fractional (..)+    , Basement.Compat.NumLiteral.HasNegation (..)+    , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64+    , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word+    , Prelude.Double, Prelude.Float+    , Prelude.IO+    , Basement.Compat.IsList.IsList (..)+    , GHC.Exts.IsString (..)+    , GHC.Generics.Generic+    , Prelude.Either (..)+    , Data.Data.Data (..)+    , Data.Data.mkNoRepType+    , Data.Data.DataType+    , Basement.Compat.Typeable.Typeable+    , Data.Monoid.Monoid (..)+    , (Data.Monoid.<>)+    , Control.Exception.Exception+    , Control.Exception.throw+    , Control.Exception.throwIO+    , GHC.Ptr.Ptr(..)+    , ifThenElse+    , internalError+    ) where++import qualified Prelude+import qualified Control.Category+import qualified Control.Applicative+import qualified Control.Exception+import qualified Control.Monad+import qualified Data.Monoid+import qualified Data.Data+import qualified Data.Word+import qualified Data.Int+import qualified Basement.Compat.IsList+import qualified Basement.Compat.NumLiteral+import qualified Basement.Compat.Typeable+import qualified GHC.Exts+import qualified GHC.Generics+import qualified GHC.Ptr+import           GHC.Exts (fromString)++-- | Only to use internally for internal error cases+internalError :: [Prelude.Char] -> a+internalError s = Prelude.error ("Internal Error: the impossible happened: " Prelude.++ s)++-- | for support of if .. then .. else+ifThenElse :: Prelude.Bool -> a -> a -> a+ifThenElse Prelude.True  e1 _  = e1+ifThenElse Prelude.False _  e2 = e2
+ Basement/Compat/Bifunctor.hs view
@@ -0,0 +1,117 @@+-- |+-- Module      : Basement.Compat.Bifunctor+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A bifunctor is a type constructor that takes+-- two type arguments and is a functor in /both/ arguments. That+-- is, unlike with 'Functor', a type constructor such as 'Either'+-- does not need to be partially applied for a 'Bifunctor'+-- instance, and the methods in this class permit mapping+-- functions over the 'Left' value or the 'Right' value,+-- or both at the same time.+--+-- Formally, the class 'Bifunctor' represents a bifunctor+-- from @Hask@ -> @Hask@.+--+-- Intuitively it is a bifunctor where both the first and second+-- arguments are covariant.+--+-- You can define a 'Bifunctor' by either defining 'bimap' or by+-- defining both 'first' and 'second'.+--+{-# LANGUAGE CPP #-}+module Basement.Compat.Bifunctor+  ( Bifunctor(..)+  ) where++#if MIN_VERSION_base(4,8,0)++import Data.Bifunctor (Bifunctor(..))++#else++import           Control.Applicative ( Const(..) )+import           GHC.Generics ( K1(..) )+import qualified Prelude as P++class Bifunctor p where+    {-# MINIMAL bimap | first, second #-}++    -- | Map over both arguments at the same time.+    --+    -- @'bimap' f g ≡ 'first' f '.' 'second' g@+    --+    -- ==== __Examples__+    --+    -- >>> bimap toUpper (+1) ('j', 3)+    -- ('J',4)+    --+    -- >>> bimap toUpper (+1) (Left 'j')+    -- Left 'J'+    --+    -- >>> bimap toUpper (+1) (Right 3)+    -- Right 4+    bimap :: (a -> b) -> (c -> d) -> p a c -> p b d+    bimap f g = first f P.. second g++    -- | Map covariantly over the first argument.+    --+    -- @'first' f ≡ 'bimap' f 'id'@+    --+    -- ==== __Examples__+    --+    -- >>> first toUpper ('j', 3)+    -- ('J',3)+    --+    -- >>> first toUpper (Left 'j')+    -- Left 'J'+    first :: (a -> b) -> p a c -> p b c+    first f = bimap f P.id++    -- | Map covariantly over the second argument.+    --+    -- @'second' ≡ 'bimap' 'id'@+    --+    -- ==== __Examples__+    -- >>> second (+1) ('j', 3)+    -- ('j',4)+    --+    -- >>> second (+1) (Right 3)+    -- Right 4+    second :: (b -> c) -> p a b -> p a c+    second = bimap P.id+++instance Bifunctor (,) where+    bimap f g ~(a, b) = (f a, g b)++instance Bifunctor ((,,) x1) where+    bimap f g ~(x1, a, b) = (x1, f a, g b)++instance Bifunctor ((,,,) x1 x2) where+    bimap f g ~(x1, x2, a, b) = (x1, x2, f a, g b)++instance Bifunctor ((,,,,) x1 x2 x3) where+    bimap f g ~(x1, x2, x3, a, b) = (x1, x2, x3, f a, g b)++instance Bifunctor ((,,,,,) x1 x2 x3 x4) where+    bimap f g ~(x1, x2, x3, x4, a, b) = (x1, x2, x3, x4, f a, g b)++instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where+    bimap f g ~(x1, x2, x3, x4, x5, a, b) = (x1, x2, x3, x4, x5, f a, g b)+++instance Bifunctor P.Either where+    bimap f _ (P.Left a) = P.Left (f a)+    bimap _ g (P.Right b) = P.Right (g b)++instance Bifunctor Const where+    bimap f _ (Const a) = Const (f a)++instance Bifunctor (K1 i) where+    bimap f _ (K1 c) = K1 (f c)++#endif
+ Basement/Compat/C/Types.hs view
@@ -0,0 +1,23 @@+{-# Language CPP #-}+-- |+-- Module      : Basement.Compat.C.Types+-- License     : BSD-style+-- Maintainer  : Foundation+--+-- Literal support for Integral and Fractional+-- {-# LANGUAGE TypeSynonymInstances #-}+-- {-# LANGUAGE FlexibleInstances #-}+module Basement.Compat.C.Types+    ( CChar(..), CSChar(..), CUChar(..)+    , CShort(..), CUShort(..), CInt(..), CUInt(..), CLong(..), CULong(..)+    , CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..), CLLong(..), CULLong(..)+#if MIN_VERSION_base(4,10,0)+    , CBool(..)+#endif+    , CIntPtr(..), CUIntPtr(..), CIntMax(..), CUIntMax(..)+    , CClock(..), CTime(..), CUSeconds(..), CSUSeconds(..), CFloat(..), CDouble+    , COff(..), CMode(..)+    ) where++import Foreign.C.Types+import System.Posix.Types
+ Basement/Compat/CallStack.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE ConstraintKinds #-}+module Basement.Compat.CallStack+    ( HasCallStack+    ) where++#if MIN_VERSION_base(4,9,0)++import GHC.Stack (HasCallStack)++#elif MIN_VERSION_base(4,8,1)++import qualified GHC.Stack++type HasCallStack = (?callStack :: GHC.Stack.CallStack)++#else++import GHC.Exts (Constraint)++type HasCallStack = (() :: Constraint)++#endif
+ Basement/Compat/ExtList.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}+module Basement.Compat.ExtList+    ( length+    , null+    , sum+    , reverse+    , (!!)+    ) where++import Basement.Compat.Base+import Basement.Numerical.Additive+import Basement.Types.OffsetSize+import qualified GHC.List as List++-- | Compute the size of the list+length :: [a] -> CountOf a+#if MIN_VERSION_base(4,8,0)+length = CountOf . List.foldl' (\c _ -> c+1) 0+#else+length = CountOf . loop 0+  where loop !acc []     = acc+        loop !acc (_:xs) = loop (1+acc) xs+#endif++null :: [a] -> Bool+null []    = True+null (_:_) = False++-- | Sum the element in a list+sum :: Additive n => [n] -> n+sum []     = azero+sum (i:is) = loop i is+  where+    loop !acc [] = acc+    loop !acc (x:xs) = loop (acc+x) xs+    {-# INLINE loop #-}++reverse :: [a] -> [a]+reverse l =  go l []+  where+    go []     acc = acc+    go (x:xs) acc = go xs (x:acc)++(!!) :: [a] -> Offset a -> a+[]    !! _  = error "invalid offset for !!"+(x:_) !! 0  = x+(_:xs) !! i = xs !! pred i
+ Basement/Compat/Identity.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Basement.Compat.Identity+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Identity re-export, with a compat wrapper for older version of base that+-- do not have Data.Functor.Identity+{-# LANGUAGE CPP #-}+module Basement.Compat.Identity+    ( Identity(..)+    ) where++#if MIN_VERSION_base(4,8,0)++import Data.Functor.Identity++#else++import Basement.Compat.Base++newtype Identity a = Identity { runIdentity :: a }+    deriving (Eq, Ord)++instance Functor Identity where+    fmap f (Identity a) = Identity (f a)++instance Applicative Identity where+    pure a = Identity a+    (<*>) fab fa = Identity $ runIdentity fab (runIdentity fa)++instance Monad Identity where+    return    = pure+    ma >>= mb = mb (runIdentity ma)++#endif
+ Basement/Compat/IsList.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Basement.Compat.IsList+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- compat friendly version of IsList+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+module Basement.Compat.IsList+    ( IsList(..)+    ) where++#if MIN_VERSION_base(4,7,0)++import           GHC.Exts++#else++import qualified Prelude++class IsList l where+  type Item l+  fromList  :: [Item l] -> l+  toList    :: l -> [Item l]++  fromListN :: Prelude.Int -> [Item l] -> l+  fromListN _ = fromList++instance IsList [a] where+    type Item [a] = a+    fromList = Prelude.id+    toList   = Prelude.id++#endif
+ Basement/Compat/MonadTrans.hs view
@@ -0,0 +1,50 @@+-- |+-- Module      : Basement.Compat.MonadTrans+-- License     : BSD-style+-- Maintainer  : Psychohistorians+-- Stability   : experimental+-- Portability : portable+--+-- An internal and really simple monad transformers,+-- without any bells and whistse.+module Basement.Compat.MonadTrans+    ( State(..)+    , Reader(..)+    ) where++import Basement.Compat.Base+import Control.Monad ((>=>))++-- | Simple State monad+newtype State s m a = State { runState :: s -> m (a, s) }++instance Monad m => Functor (State s m) where+    fmap f fa = State $ runState fa >=> (\(a, s2) -> return (f a, s2))+instance Monad m => Applicative (State s m) where+    pure a = State $ \st -> return (a,st)+    fab <*> fa = State $ \s1 -> do+        (ab,s2) <- runState fab s1+        (a,s3)  <- runState fa s2+        return (ab a, s3)+instance Monad m => Monad (State r m) where+    return a = State $ \st -> return (a,st)+    ma >>= mb = State $ \s1 -> do+        (a,s2) <- runState ma s1+        runState (mb a) s2++-- | Simple Reader monad+newtype Reader r m a = Reader { runReader :: r -> m a }++instance Monad m => Functor (Reader r m) where+    fmap f fa = Reader $ runReader fa >=> (\a -> return (f a))+instance Monad m => Applicative (Reader r m) where+    pure a = Reader $ \_ -> return a+    fab <*> fa = Reader $ \r -> do+        a  <- runReader fa r+        ab <- runReader fab r+        return $ ab a+instance Monad m => Monad (Reader r m) where+    return a = Reader $ \_ -> return a+    ma >>= mb = Reader $ \r -> do+        a <- runReader ma r+        runReader (mb a) r
+ Basement/Compat/Natural.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Basement.Compat.Natural+    ( Natural+    , integerToNatural+    , naturalToInteger+    ) where++#if MIN_VERSION_base(4,8,0)++import Numeric.Natural+import Prelude (Integer, abs, fromInteger, toInteger)++#else++import Prelude (Show(..),Eq,Ord,Enum,Num(..),Real(..),Integral(..),Integer,error,(<), (>), otherwise, toInteger)+import Data.Bits+import Data.Typeable++newtype Natural = Natural Integer+    deriving (Eq,Ord,Enum,Typeable,Bits)++instance Show Natural where+    show (Natural i) = show i++-- re-create the buggy Num instance for Natural+instance Num Natural where+    fromInteger n+        | n < 0     = error "natural should be positive: "+        | otherwise = Natural n+    (+) (Natural a) (Natural b) = Natural (a + b)+    (-) (Natural a) (Natural b)+        | r < 0     = error "natural should be positve"+        | otherwise = Natural (a - b)+      where r = (a - b)+    (*) (Natural a) (Natural b) = Natural (a * b)+    abs n = n+    negate n = n+    signum (Natural n)+        | n > 0     = 1+        | otherwise = 0++instance Real Natural where+    toRational (Natural n) = toRational n++instance Integral Natural where+    toInteger (Natural n) = n+    divMod (Natural n) (Natural e) = let (a,b) = n `quotRem` e in (Natural a, Natural b)+    quotRem (Natural n) (Natural e) = let (a,b) = n `quotRem` e in (Natural a, Natural b)+    quot (Natural n) (Natural e) = Natural (n `quot` e)+    rem (Natural n) (Natural e) = Natural (n `rem` e)+    div = quot+    mod = rem++#endif++integerToNatural :: Integer -> Natural+integerToNatural i = fromInteger (abs i)++naturalToInteger :: Natural -> Integer+naturalToInteger n = toInteger n
+ Basement/Compat/NumLiteral.hs view
@@ -0,0 +1,195 @@+{-# Language CPP #-}+-- |+-- Module      : Basement.Compat.NumLiteral+-- License     : BSD-style+-- Maintainer  : Foundation+--+-- Literal support for Integral and Fractional+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+module Basement.Compat.NumLiteral+    ( Integral(..)+    , Fractional(..)+    , HasNegation(..)+    ) where++import           Prelude (Int, Integer, Rational, Float, Double)+import           Data.Word (Word8, Word16, Word32, Word64, Word)+import           Data.Int (Int8, Int16, Int32, Int64)+import           Basement.Compat.C.Types+import qualified Prelude+import           Basement.Compat.Natural+import           Foreign.Ptr (IntPtr)++-- | Integral Literal support+--+-- e.g. 123 :: Integer+--      123 :: Word8+class Integral a where+    fromInteger :: Integer -> a++-- | Fractional Literal support+--+-- e.g. 1.2  :: Double+--      0.03 :: Float+class Fractional a where+    fromRational :: Rational -> a++-- | Negation support+--+-- e.g. -(f x)+class HasNegation a where+    negate :: a -> a++instance Integral Integer where+    fromInteger a = a+instance Integral Natural where+    fromInteger a = Prelude.fromInteger a+instance Integral Int where+    fromInteger a = Prelude.fromInteger a+instance Integral Word where+    fromInteger a = Prelude.fromInteger a+instance Integral Word8 where+    fromInteger a = Prelude.fromInteger a+instance Integral Word16 where+    fromInteger a = Prelude.fromInteger a+instance Integral Word32 where+    fromInteger a = Prelude.fromInteger a+instance Integral Word64 where+    fromInteger a = Prelude.fromInteger a+instance Integral Int8 where+    fromInteger a = Prelude.fromInteger a+instance Integral Int16 where+    fromInteger a = Prelude.fromInteger a+instance Integral Int32 where+    fromInteger a = Prelude.fromInteger a+instance Integral Int64 where+    fromInteger a = Prelude.fromInteger a+instance Integral IntPtr where+    fromInteger a = Prelude.fromInteger a++instance Integral Float where+    fromInteger a = Prelude.fromInteger a+instance Integral Double where+    fromInteger a = Prelude.fromInteger a++instance Integral CChar where+    fromInteger a = Prelude.fromInteger a+instance Integral CSChar where+    fromInteger a = Prelude.fromInteger a+instance Integral CUChar where+    fromInteger a = Prelude.fromInteger a+instance Integral CShort where+    fromInteger a = Prelude.fromInteger a+instance Integral CUShort where+    fromInteger a = Prelude.fromInteger a+instance Integral CInt where+    fromInteger a = Prelude.fromInteger a+instance Integral CUInt where+    fromInteger a = Prelude.fromInteger a+instance Integral CLong where+    fromInteger a = Prelude.fromInteger a+instance Integral CULong where+    fromInteger a = Prelude.fromInteger a+instance Integral CPtrdiff where+    fromInteger a = Prelude.fromInteger a+instance Integral CSize where+    fromInteger a = Prelude.fromInteger a+instance Integral CWchar where+    fromInteger a = Prelude.fromInteger a+instance Integral CSigAtomic where+    fromInteger a = Prelude.fromInteger a+instance Integral CLLong where+    fromInteger a = Prelude.fromInteger a+instance Integral CULLong where+    fromInteger a = Prelude.fromInteger a+#if MIN_VERSION_base(4, 10, 0)+instance Integral CBool where+    fromInteger a = Prelude.fromInteger a+#endif+instance Integral CIntPtr where+    fromInteger a = Prelude.fromInteger a+instance Integral CUIntPtr where+    fromInteger a = Prelude.fromInteger a+instance Integral CIntMax where+    fromInteger a = Prelude.fromInteger a+instance Integral CUIntMax where+    fromInteger a = Prelude.fromInteger a+instance Integral CClock where+    fromInteger a = Prelude.fromInteger a+instance Integral CTime where+    fromInteger a = Prelude.fromInteger a+instance Integral CUSeconds where+    fromInteger a = Prelude.fromInteger a+instance Integral CSUSeconds where+    fromInteger a = Prelude.fromInteger a+instance Integral COff where+    fromInteger a = Prelude.fromInteger a+instance Integral CFloat where+    fromInteger a = Prelude.fromInteger a+instance Integral CDouble where+    fromInteger a = Prelude.fromInteger a++instance HasNegation Integer where+    negate = Prelude.negate+instance HasNegation Int where+    negate = Prelude.negate+instance HasNegation Int8 where+    negate = Prelude.negate+instance HasNegation Int16 where+    negate = Prelude.negate+instance HasNegation Int32 where+    negate = Prelude.negate+instance HasNegation Int64 where+    negate = Prelude.negate+instance HasNegation Word where+    negate = Prelude.negate+instance HasNegation Word8 where+    negate = Prelude.negate+instance HasNegation Word16 where+    negate = Prelude.negate+instance HasNegation Word32 where+    negate = Prelude.negate+instance HasNegation Word64 where+    negate = Prelude.negate++instance HasNegation Float where+    negate = Prelude.negate+instance HasNegation Double where+    negate = Prelude.negate++instance HasNegation CChar where+    negate = Prelude.negate+instance HasNegation CSChar where+    negate = Prelude.negate+instance HasNegation CShort where+    negate = Prelude.negate+instance HasNegation CInt where+    negate = Prelude.negate+instance HasNegation CLong where+    negate = Prelude.negate+instance HasNegation CPtrdiff where+    negate = Prelude.negate+instance HasNegation CWchar where+    negate = Prelude.negate+instance HasNegation CLLong where+    negate = Prelude.negate+instance HasNegation CIntMax where+    negate = Prelude.negate++instance HasNegation CFloat where+    negate = Prelude.negate+instance HasNegation CDouble where+    negate = Prelude.negate++instance Fractional Rational where+    fromRational a = Prelude.fromRational a+instance Fractional Float where+    fromRational a = Prelude.fromRational a+instance Fractional Double where+    fromRational a = Prelude.fromRational a++instance Fractional CFloat where+    fromRational a = Prelude.fromRational a+instance Fractional CDouble where+    fromRational a = Prelude.fromRational a
+ Basement/Compat/PrimTypes.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Basement.Compat.PrimTypes+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+module Basement.Compat.PrimTypes+    ( FileSize#+    , Offset#+    , CountOf#+    , Bool#+    , Pinned#+    ) where++import GHC.Prim++-- | File size in bytes+type FileSize# = Word64#++-- | Offset in a bytearray, string, type alias+--+-- for code documentation purpose only, just a simple type alias on Int#+type Offset# = Int#++-- | CountOf in bytes type alias+--+-- for code documentation purpose only, just a simple type alias on Int#+type CountOf# = Int#++-- | Lowlevel Boolean+type Bool# = Int#++-- | Pinning status+type Pinned# = Bool#
+ Basement/Compat/Primitive.hs view
@@ -0,0 +1,79 @@+-- |+-- Module      : Basement.Compat.Primitive+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnliftedFFITypes #-}+module Basement.Compat.Primitive+    ( bool#+    , PinnedStatus(..), toPinnedStatus#+    , compatMkWeak#+    , compatIsByteArrayPinned#+    , compatIsMutableByteArrayPinned#+    , unsafeCoerce#+    , Word(..)+    ) where++import qualified Prelude+import           GHC.Exts+import           GHC.Prim+import           GHC.Word+import           GHC.IO++import           Basement.Compat.PrimTypes++--  GHC 9.0  | Base 4.15+--  GHC 8.8  | Base 4.13 4.14+--  GHC 8.6  | Base 4.12+--  GHC 8.4  | Base 4.11+--  GHC 8.2  | Base 4.10+--  GHC 8.0  | Base 4.9+--  GHC 7.10 | Base 4.8+--  GHC 7.8  | Base 4.7+--  GHC 7.6  | Base 4.6+--  GHC 7.4  | Base 4.5+--+--  More complete list:+--  https://wiki.haskell.org/Base_package++-- | Flag record whether a specific byte array is pinned or not+data PinnedStatus = Pinned | Unpinned+    deriving (Prelude.Eq)++toPinnedStatus# :: Pinned# -> PinnedStatus+toPinnedStatus# 0# = Unpinned+toPinnedStatus# _  = Pinned++-- | turn an Int# into a Bool+bool# :: Int# -> Prelude.Bool+bool# v = isTrue# v+{-# INLINE bool# #-}++-- | A mkWeak# version that keep working on 8.0+--+-- signature change in ghc-prim:+-- * 0.4: mkWeak# :: o -> b -> c                                             -> State# RealWorld -> (#State# RealWorld, Weak# b#)+-- * 0.5 :mkWeak# :: o -> b -> (State# RealWorld -> (#State# RealWorld, c#)) -> State# RealWorld -> (#State# RealWorld, Weak# b#)+--+compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)+compatMkWeak# o b c s = mkWeak# o b (case c of { IO f -> f }) s+{-# INLINE compatMkWeak# #-}++#if __GLASGOW_HASKELL__ >= 802+compatIsByteArrayPinned# :: ByteArray# -> Pinned#+compatIsByteArrayPinned# ba = isByteArrayPinned# ba++compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#+compatIsMutableByteArrayPinned# ba = isMutableByteArrayPinned# ba+#else+foreign import ccall unsafe "basement_is_bytearray_pinned"+    compatIsByteArrayPinned# :: ByteArray# -> Pinned#++foreign import ccall unsafe "basement_is_bytearray_pinned"+    compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#+#endif
+ Basement/Compat/Semigroup.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE CPP #-}+#if !(MIN_VERSION_base(4,9,0))+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+#endif+module Basement.Compat.Semigroup+    ( Semigroup(..)+    , ListNonEmpty(..)+    ) where++#if MIN_VERSION_base(4,9,0)+import           Data.Semigroup+import qualified Data.List.NonEmpty as LNE++type ListNonEmpty = LNE.NonEmpty+#else+import Prelude+import Data.Data (Data)+import Data.Monoid (Monoid(..))+import GHC.Generics (Generic)+import Data.Typeable++-- errorWithoutStackTrace++infixr 6 <>+infixr 5 :|++data ListNonEmpty a = a :| [a]+  deriving ( Eq, Ord, Show, Read, Data, Typeable, Generic )++-- | The class of semigroups (types with an associative binary operation).+--+-- @since 4.9.0.0+class Semigroup a where+  -- | An associative operation.+  --+  -- @+  -- (a '<>' b) '<>' c = a '<>' (b '<>' c)+  -- @+  --+  -- If @a@ is also a 'Monoid' we further require+  --+  -- @+  -- ('<>') = 'mappend'+  -- @+  (<>) :: a -> a -> a++  default (<>) :: Monoid a => a -> a -> a+  (<>) = mappend++  -- | Reduce a non-empty list with @\<\>@+  --+  -- The default definition should be sufficient, but this can be+  -- overridden for efficiency.+  --+  sconcat :: ListNonEmpty a -> a+  sconcat (a :| as) = go a as where+    go b (c:cs) = b <> go c cs+    go b []     = b++  -- | Repeat a value @n@ times.+  --+  -- Given that this works on a 'Semigroup' it is allowed to fail if+  -- you request 0 or fewer repetitions, and the default definition+  -- will do so.+  --+  -- By making this a member of the class, idempotent semigroups and monoids can+  -- upgrade this to execute in /O(1)/ by picking+  -- @stimes = stimesIdempotent@ or @stimes = stimesIdempotentMonoid@+  -- respectively.+  stimes :: Integral b => b -> a -> a+  stimes y0 x0+    | y0 <= 0   = errorWithoutStackTrace "stimes: positive multiplier expected"+    | otherwise = f x0 y0+    where+      f x y+        | even y = f (x <> x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x <> x) (pred y  `quot` 2) x+      g x y z+        | even y = g (x <> x) (y `quot` 2) z+        | y == 1 = x <> z+        | otherwise = g (x <> x) (pred y `quot` 2) (x <> z)++instance Semigroup a => Semigroup (Maybe a) where+  Nothing <> b       = b+  a       <> Nothing = a+  Just a  <> Just b  = Just (a <> b)+  stimes _ Nothing  = Nothing+  stimes n (Just a) = case compare n 0 of+    LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"+    EQ -> Nothing+    GT -> Just (stimes n a)++instance Semigroup [a] where+    (<>) = (++)++instance Semigroup (Either a b) where+  Left _ <> b = b+  a      <> _ = a+  stimes = stimesIdempotent++instance (Semigroup a, Semigroup b) => Semigroup (a, b) where+  (a,b) <> (a',b') = (a<>a',b<>b')+  stimes n (a,b) = (stimes n a, stimes n b)++instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where+  (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')+  stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)++instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)+         => Semigroup (a, b, c, d) where+  (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')+  stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)++instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)+         => Semigroup (a, b, c, d, e) where+  (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')+  stimes n (a,b,c,d,e) =+      (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)++-- | This is a valid definition of 'stimes' for a 'Monoid'.+--+-- Unlike the default definition of 'stimes', it is defined for 0+-- and so it should be preferred where possible.+stimesMonoid :: (Integral b, Monoid a) => b -> a -> a+stimesMonoid n x0 = case compare n 0 of+  LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"+  EQ -> mempty+  GT -> f x0 n+    where+      f x y+        | even y = f (x `mappend` x) (y `quot` 2)+        | y == 1 = x+        | otherwise = g (x `mappend` x) (pred y  `quot` 2) x+      g x y z+        | even y = g (x `mappend` x) (y `quot` 2) z+        | y == 1 = x `mappend` z+        | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)++-- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.+--+-- When @mappend x x = x@, this definition should be preferred, because it+-- works in /O(1)/ rather than /O(log n)/+stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a+stimesIdempotentMonoid n x = case compare n 0 of+  LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"+  EQ -> mempty+  GT -> x++-- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.+--+-- When @x <> x = x@, this definition should be preferred, because it+-- works in /O(1)/ rather than /O(log n)/.+stimesIdempotent :: Integral b => b -> a -> a+stimesIdempotent n x+  | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"+  | otherwise = x++#if !MIN_VERSION_base(4,9,0)+errorWithoutStackTrace = error+#endif++#endif
+ Basement/Compat/Typeable.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Basement.Compat.Typeable+-- License     : BSD-style+-- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>+-- Stability   : statble+-- Portability : portable+--+-- conveniently provide support for legacy and modern base+--++{-# LANGUAGE CPP #-}++module Basement.Compat.Typeable+    (+#if MIN_VERSION_base(4,7,0)+      Typeable+#else+      Typeable(..)+    , typeRep+#endif+    ) where++#if !MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy(..))+import qualified Prelude (undefined)+#endif+import Data.Typeable++#if !MIN_VERSION_base(4,7,0)+-- this function does not exist prior base 4.7+typeRep :: Typeable a => Proxy a -> TypeRep+typeRep = typeRep' Prelude.undefined+  where+    typeRep' :: Typeable a => a -> Proxy a -> TypeRep+    typeRep' a _ = typeOf a+    {-# INLINE typeRep' #-}+#endif
+ Basement/Endianness.hs view
@@ -0,0 +1,141 @@+-- |+-- Module      : Basement.Endianness+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+-- Stability   : experimental+-- Portability : portable+--+-- Set endianness tag to a given primitive. This will help for serialising+-- data for protocols (such as the network protocols).+--++{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Basement.Endianness+    (+      ByteSwap+      -- * Big Endian+    , BE(..), toBE, fromBE+      -- * Little Endian+    , LE(..), toLE, fromLE+      -- * System Endianness+    , Endianness(..)+    , endianness+    ) where++import Basement.Compat.Base+import Data.Word (byteSwap16, byteSwap32, byteSwap64)++#if defined(ARCH_IS_LITTLE_ENDIAN) || defined(ARCH_IS_BIG_ENDIAN)+#else+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (castPtr)+import Foreign.Storable (poke, peek)+import Data.Word (Word8, Word32)+import System.IO.Unsafe (unsafePerformIO)+#endif++import Data.Bits+++-- #if !defined(ARCH_IS_LITTLE_ENDIAN) && !defined(ARCH_IS_BIG_ENDIAN)+-- import Foundation.System.Info (endianness, Endianness(..))+-- #endif++data Endianness =+      LittleEndian+    | BigEndian+    deriving (Eq, Show)++-- | Little Endian value+newtype LE a = LE { unLE :: a }+  deriving (Show, Eq, Typeable, Bits)+instance (ByteSwap a, Ord a) => Ord (LE a) where+    compare e1 e2 = compare (fromLE e1) (fromLE e2)++-- | Big Endian value+newtype BE a = BE { unBE :: a }+  deriving (Show, Eq, Typeable, Bits)+instance (ByteSwap a, Ord a) => Ord (BE a) where+    compare e1 e2 = compare (fromBE e1) (fromBE e2)++-- | Convert a value in cpu endianess to big endian+toBE :: ByteSwap a => a -> BE a+#ifdef ARCH_IS_LITTLE_ENDIAN+toBE = BE . byteSwap+#elif ARCH_IS_BIG_ENDIAN+toBE = BE+#else+toBE = BE . (if endianness == LittleEndian then byteSwap else id)+#endif+{-# INLINE toBE #-}++-- | Convert from a big endian value to the cpu endianness+fromBE :: ByteSwap a => BE a -> a+#ifdef ARCH_IS_LITTLE_ENDIAN+fromBE (BE a) = byteSwap a+#elif ARCH_IS_BIG_ENDIAN+fromBE (BE a) = a+#else+fromBE (BE a) = if endianness == LittleEndian then byteSwap a else a+#endif+{-# INLINE fromBE #-}++-- | Convert a value in cpu endianess to little endian+toLE :: ByteSwap a => a -> LE a+#ifdef ARCH_IS_LITTLE_ENDIAN+toLE = LE+#elif ARCH_IS_BIG_ENDIAN+toLE = LE . byteSwap+#else+toLE = LE . (if endianness == LittleEndian then id else byteSwap)+#endif+{-# INLINE toLE #-}++-- | Convert from a little endian value to the cpu endianness+fromLE :: ByteSwap a => LE a -> a+#ifdef ARCH_IS_LITTLE_ENDIAN+fromLE (LE a) = a+#elif ARCH_IS_BIG_ENDIAN+fromLE (LE a) = byteSwap a+#else+fromLE (LE a) = if endianness == LittleEndian then a else byteSwap a+#endif+{-# INLINE fromLE #-}++-- | endianness of the current architecture+endianness :: Endianness+#ifdef ARCH_IS_LITTLE_ENDIAN+endianness = LittleEndian+#elif ARCH_IS_BIG_ENDIAN+endianness = BigEndian+#else+-- ! ARCH_IS_UNKNOWN_ENDIAN+endianness = unsafePerformIO $ bytesToEndianness <$> word32ToByte input+  where+    input :: Word32+    input = 0x01020304+{-# NOINLINE endianness #-}++word32ToByte :: Word32 -> IO Word8+word32ToByte word = alloca $ \wordPtr -> do+         poke wordPtr word+         peek (castPtr wordPtr)++bytesToEndianness :: Word8 -> Endianness+bytesToEndianness 1 = BigEndian+bytesToEndianness _ = LittleEndian+#endif++-- | Class of types that can be byte-swapped.+--+-- e.g. Word16, Word32, Word64+class ByteSwap a where+    byteSwap :: a -> a+instance ByteSwap Word16 where+    byteSwap = byteSwap16+instance ByteSwap Word32 where+    byteSwap = byteSwap32+instance ByteSwap Word64 where+    byteSwap = byteSwap64
+ Basement/Environment.hs view
@@ -0,0 +1,16 @@+module Basement.Environment+    ( getArgs+    , lookupEnv+    ) where++import           Basement.Compat.Base+import           Basement.UTF8.Base (String)+import qualified System.Environment as Sys (getArgs, lookupEnv)++-- | Returns a list of the program's command line arguments (not including the program name).+getArgs :: IO [String]+getArgs = fmap fromList <$> Sys.getArgs++-- | Lookup variable in the environment+lookupEnv :: String -> IO (Maybe String)+lookupEnv s = fmap fromList <$> Sys.lookupEnv (toList s)
+ Basement/Error.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TypeInType #-}+#endif+module Basement.Error+    ( error+    ) where++import           GHC.Prim+import           Basement.UTF8.Base+import           Basement.Compat.CallStack++#if MIN_VERSION_base(4,9,0)++import           GHC.Types (RuntimeRep)+import           GHC.Exception (errorCallWithCallStackException)++-- | stop execution and displays an error message+error :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => String -> a+error s = raise# (errorCallWithCallStackException (sToList s) ?callstack)++#elif MIN_VERSION_base(4,7,0)++import           GHC.Exception (errorCallException)++error :: String -> a+error s = raise# (errorCallException (sToList s))++#else++import           GHC.Types+import           GHC.Exception++error :: String -> a+error s = throw (ErrorCall (sToList s))++#endif
+ Basement/Exception.hs view
@@ -0,0 +1,71 @@+-- |+-- Module      : Basement.Exception+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Common part for vectors+--+{-# LANGUAGE DeriveDataTypeable #-}+module Basement.Exception+    ( OutOfBound(..)+    , OutOfBoundOperation(..)+    , isOutOfBound+    , outOfBound+    , primOutOfBound+    , InvalidRecast(..)+    , RecastSourceSize(..)+    , RecastDestinationSize(..)+    , NonEmptyCollectionIsEmpty(..)+    ) where++import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           Basement.Monad++-- | The type of operation that triggers an OutOfBound exception.+--+-- * OOB_Index: reading an immutable vector+-- * OOB_Read: reading a mutable vector+-- * OOB_Write: write a mutable vector+-- * OOB_MemCopy: copying a vector+-- * OOB_MemSet: initializing a mutable vector+data OutOfBoundOperation = OOB_Read | OOB_Write | OOB_MemSet | OOB_MemCopy | OOB_Index+    deriving (Show,Eq,Typeable)++-- | Exception during an operation accessing the vector out of bound+--+-- Represent the type of operation, the index accessed, and the total length of the vector.+data OutOfBound = OutOfBound OutOfBoundOperation Int Int+    deriving (Show,Typeable)++instance Exception OutOfBound++outOfBound :: OutOfBoundOperation -> Offset ty -> CountOf ty -> a+outOfBound oobop (Offset ofs) (CountOf sz) = throw (OutOfBound oobop ofs sz)+{-# INLINE outOfBound #-}++primOutOfBound :: PrimMonad prim => OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a+primOutOfBound oobop (Offset ofs) (CountOf sz) = primThrow (OutOfBound oobop ofs sz)+{-# INLINE primOutOfBound #-}++isOutOfBound :: Offset ty -> CountOf ty -> Bool+isOutOfBound (Offset ty) (CountOf sz) = ty < 0 || ty >= sz+{-# INLINE isOutOfBound #-}++newtype RecastSourceSize      = RecastSourceSize Int+    deriving (Show,Eq,Typeable)+newtype RecastDestinationSize = RecastDestinationSize Int+    deriving (Show,Eq,Typeable)++data InvalidRecast = InvalidRecast RecastSourceSize RecastDestinationSize+    deriving (Show,Typeable)++instance Exception InvalidRecast++-- | Exception for using NonEmpty assertion with an empty collection+data NonEmptyCollectionIsEmpty = NonEmptyCollectionIsEmpty+    deriving (Show,Typeable)++instance Exception NonEmptyCollectionIsEmpty
+ Basement/FinalPtr.hs view
@@ -0,0 +1,112 @@+-- |+-- Module      : Basement.FinalPtr+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A smaller ForeignPtr reimplementation that work in any prim monad.+--+-- Here be dragon.+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE CPP #-}+module Basement.FinalPtr+    ( FinalPtr(..)+    , finalPtrSameMemory+    , castFinalPtr+    , toFinalPtr+    , toFinalPtrForeign+    , touchFinalPtr+    , withFinalPtr+    , withUnsafeFinalPtr+    , withFinalPtrNoTouch+    ) where++import GHC.Ptr+import qualified GHC.ForeignPtr as GHCF+import GHC.IO+import Basement.Monad+import Basement.Compat.Primitive+import Basement.Compat.Base++import Control.Monad.ST (runST)++-- | Create a pointer with an associated finalizer+data FinalPtr a = FinalPtr (Ptr a)+                | FinalForeign (GHCF.ForeignPtr a)+instance Show (FinalPtr a) where+    show f = runST $ withFinalPtr f (pure . show)+instance Eq (FinalPtr a) where+    (==) f1 f2 = runST (equal f1 f2)+instance Ord (FinalPtr a) where+    compare f1 f2 = runST (compare_ f1 f2)++-- | Check if 2 final ptr points on the same memory bits+--+-- it stand to reason that provided a final ptr that is still being referenced+-- and thus have the memory still valid, if 2 final ptrs have the+-- same address, they should be the same final ptr+finalPtrSameMemory :: FinalPtr a -> FinalPtr b -> Bool+finalPtrSameMemory (FinalPtr p1)     (FinalPtr p2)     = p1 == castPtr p2+finalPtrSameMemory (FinalForeign p1) (FinalForeign p2) = p1 == GHCF.castForeignPtr p2+finalPtrSameMemory (FinalForeign _)  (FinalPtr _)      = False+finalPtrSameMemory (FinalPtr _)      (FinalForeign _)  = False++-- | create a new FinalPtr from a Pointer+toFinalPtr :: PrimMonad prim => Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)+toFinalPtr ptr finalizer = unsafePrimFromIO (primitive makeWithFinalizer)+  where+    makeWithFinalizer s =+        case compatMkWeak# ptr () (finalizer ptr) s of { (# s2, _ #) -> (# s2, FinalPtr ptr #) }++-- | Create a new FinalPtr from a ForeignPtr+toFinalPtrForeign :: GHCF.ForeignPtr a -> FinalPtr a+toFinalPtrForeign fptr = FinalForeign fptr++-- | Cast a finalized pointer from type a to type b+castFinalPtr :: FinalPtr a -> FinalPtr b+castFinalPtr (FinalPtr a)     = FinalPtr (castPtr a)+castFinalPtr (FinalForeign a) = FinalForeign (GHCF.castForeignPtr a)++withFinalPtrNoTouch :: FinalPtr p -> (Ptr p -> a) -> a+withFinalPtrNoTouch (FinalPtr ptr) f = f ptr+withFinalPtrNoTouch (FinalForeign fptr) f = f (GHCF.unsafeForeignPtrToPtr fptr)+{-# INLINE withFinalPtrNoTouch #-}++-- | Looks at the raw pointer inside a FinalPtr, making sure the+-- data pointed by the pointer is not finalized during the call to 'f'+withFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> prim a+withFinalPtr (FinalPtr ptr) f = do+    r <- f ptr+    primTouch ptr+    pure r+withFinalPtr (FinalForeign fptr) f = do+    r <- f (GHCF.unsafeForeignPtrToPtr fptr)+    unsafePrimFromIO (GHCF.touchForeignPtr fptr)+    pure r+{-# INLINE withFinalPtr #-}++touchFinalPtr :: PrimMonad prim => FinalPtr p -> prim ()+touchFinalPtr (FinalPtr ptr) = primTouch ptr+touchFinalPtr (FinalForeign fptr) = unsafePrimFromIO (GHCF.touchForeignPtr fptr)++-- | Unsafe version of 'withFinalPtr'+withUnsafeFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> a+withUnsafeFinalPtr fptr f = unsafePerformIO (unsafePrimToIO (withFinalPtr fptr f))+{-# NOINLINE withUnsafeFinalPtr #-}++equal :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Bool+equal f1 f2 =+    withFinalPtr f1 $ \ptr1 ->+    withFinalPtr f2 $ \ptr2 ->+        pure $ ptr1 == ptr2+{-# INLINE equal #-}++compare_ :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Ordering+compare_ f1 f2 =+    withFinalPtr f1 $ \ptr1 ->+    withFinalPtr f2 $ \ptr2 ->+        pure $ ptr1 `compare` ptr2+{-# INLINE compare_ #-}
+ Basement/Floating.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+module Basement.Floating+    ( integerToDouble+    , naturalToDouble+    , doubleExponant+    , integerToFloat+    , naturalToFloat+    , wordToFloat+    , floatToWord+    , wordToDouble+    , doubleToWord+    ) where++import           GHC.Types+import           GHC.Prim+import           GHC.Float+import           GHC.Word+import           GHC.ST+import           Basement.Compat.Base+import           Basement.Compat.Natural+import qualified Prelude (fromInteger, toInteger, (^^))++integerToDouble :: Integer -> Double+integerToDouble = Prelude.fromInteger+-- this depends on integer-gmp+--integerToDouble i = D# (doubleFromInteger i)++naturalToDouble :: Natural -> Double+naturalToDouble = integerToDouble . Prelude.toInteger++doubleExponant :: Double -> Int -> Double+doubleExponant = (Prelude.^^)++integerToFloat :: Integer -> Float+integerToFloat = Prelude.fromInteger++naturalToFloat :: Natural -> Float+naturalToFloat = integerToFloat . Prelude.toInteger++wordToFloat :: Word32 -> Float+wordToFloat (W32# x) = runST $ ST $ \s1 ->+    case newByteArray# 4# s1             of { (# s2, mbarr #) ->+    case writeWord32Array# mbarr 0# x s2 of { s3              ->+    case readFloatArray# mbarr 0# s3     of { (# s4, f #)     ->+        (# s4, F# f #) }}}+{-# INLINE wordToFloat #-}++floatToWord :: Float -> Word32+floatToWord (F# x) = runST $ ST $ \s1 ->+    case newByteArray# 4# s1            of { (# s2, mbarr #) ->+    case writeFloatArray# mbarr 0# x s2 of { s3              ->+    case readWord32Array# mbarr 0# s3   of { (# s4, w #)     ->+        (# s4, W32# w #) }}}+{-# INLINE floatToWord #-}++wordToDouble :: Word64 -> Double+wordToDouble (W64# x) = runST $ ST $ \s1 ->+    case newByteArray# 8# s1             of { (# s2, mbarr #) ->+    case writeWord64Array# mbarr 0# x s2 of { s3              ->+    case readDoubleArray# mbarr 0# s3    of { (# s4, f #)     ->+        (# s4, D# f #) }}}+{-# INLINE wordToDouble #-}++doubleToWord :: Double -> Word64+doubleToWord (D# x) = runST $ ST $ \s1 ->+    case newByteArray# 8# s1             of { (# s2, mbarr #) ->+    case writeDoubleArray# mbarr 0# x s2 of { s3              ->+    case readWord64Array# mbarr 0# s3    of { (# s4, w #)     ->+        (# s4, W64# w #) }}}+{-# INLINE doubleToWord #-}
+ Basement/From.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE TypeOperators         #-}+-- |+-- Module      : Basement.From+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- Flexible Type convertion+--+-- From is multi parameter type class that allow converting+-- from a to b.+--+-- Only type that are valid to convert to another type+-- should be From instance; otherwise TryFrom should be used.+--+-- Into (resp TryInto) allows the contrary instances to be able+-- to specify the destination type before the source. This is+-- practical with TypeApplication+module Basement.From+    ( From(..)+    , Into+    , TryFrom(..)+    , TryInto+    , into+    , tryInto+    ) where++import           Basement.Compat.Base++-- basic instances+import           GHC.Types+import           GHC.Prim+#if __GLASGOW_HASKELL__ >= 903+  hiding (word64ToWord#)+#endif+import           GHC.Int+import           GHC.Word+import           Basement.Numerical.Number+import           Basement.Numerical.Conversion+import qualified Basement.Block as Block+import qualified Basement.BoxedArray as BoxArray+import           Basement.Cast (cast)+import qualified Basement.UArray as UArray+import qualified Basement.String as String+import qualified Basement.Types.AsciiString as AsciiString+import           Basement.Types.Word128 (Word128(..))+import           Basement.Types.Word256 (Word256(..))+import qualified Basement.Types.Word128 as Word128+import qualified Basement.Types.Word256 as Word256+import           Basement.These+import           Basement.PrimType (PrimType, PrimSize)+import           Basement.Types.OffsetSize+import           Basement.Compat.Natural+import           Basement.HeadHackageUtils+import qualified Prelude (fromIntegral)++-- nat instances+#if __GLASGOW_HASKELL__ >= 800+import           Basement.Nat+import qualified Basement.Sized.Block as BlockN+import           Basement.Bounded+#endif++-- | Class of things that can be converted from a to b.+--+-- In a valid instance, the source should be always representable by the destination,+-- otherwise the instance should be using 'TryFrom'+class From a b where+    from :: a -> b++type Into b a = From a b++-- | Same as from but reverse the type variable so that the destination type can be specified first+--+-- e.g. converting:+--+-- from @_ @Word (10 :: Int)+--+-- into @Word (10 :: Int)+--+into :: Into b a => a -> b+into = from++-- | Class of things that can mostly be converted from a to b, but with possible error cases.+class TryFrom a b where+    tryFrom :: a -> Maybe b++type TryInto b a = TryFrom a b++-- | same as tryFrom but reversed+tryInto :: TryInto b a => a -> Maybe b+tryInto = tryFrom++instance From a a where+    from = id++instance IsNatural n => From n Natural where+    from = toNatural+instance IsIntegral n => From n Integer where+    from = toInteger++instance From Int8 Int16 where+    from (I8# i) = I16# (intToInt16Compat# (int8ToIntCompat# i))+instance From Int8 Int32 where+    from (I8# i) = I32# (intToInt32Compat# (int8ToIntCompat# i))+instance From Int8 Int64 where+    from (I8# i) = intToInt64 (I# (int8ToIntCompat# i))+instance From Int8 Int where+    from (I8# i) = I# (int8ToIntCompat# i)++instance From Int16 Int32 where+    from (I16# i) = I32# (intToInt32Compat# (int16ToIntCompat# i))+instance From Int16 Int64 where+    from (I16# i) = intToInt64 (I# (int16ToIntCompat# i))+instance From Int16 Int where+    from (I16# i) = I# (int16ToIntCompat# i)++instance From Int32 Int64 where+    from (I32# i) = intToInt64 (I# (int32ToIntCompat# i))+instance From Int32 Int where+    from (I32# i) = I# (int32ToIntCompat# i)++instance From Int Int64 where+    from = intToInt64++instance From Word8 Word16 where+    from (W8# i) = W16# (wordToWord16Compat# (word8ToWordCompat# i))+instance From Word8 Word32 where+    from (W8# i) = W32# (wordToWord32Compat# (word8ToWordCompat# i))+instance From Word8 Word64 where+    from (W8# i) = wordToWord64 (W# (word8ToWordCompat# i))+instance From Word8 Word128 where+    from (W8# i) = Word128 0 (wordToWord64 $ W# (word8ToWordCompat# i))+instance From Word8 Word256 where+    from (W8# i) = Word256 0 0 0 (wordToWord64 $ W# (word8ToWordCompat# i))+instance From Word8 Word where+    from (W8# i) = W# (word8ToWordCompat# i)+instance From Word8 Int16 where+    from (W8# w) = I16# (intToInt16Compat# (word2Int# (word8ToWordCompat# w)))+instance From Word8 Int32 where+    from (W8# w) = I32# (intToInt32Compat# (word2Int# (word8ToWordCompat# w)))+instance From Word8 Int64 where+    from (W8# w) = intToInt64 (I# (word2Int# (word8ToWordCompat# w)))+instance From Word8 Int where+    from (W8# w) = I# (word2Int# (word8ToWordCompat# w))++instance From Word16 Word32 where+    from (W16# i) = W32# (wordToWord32Compat# (word16ToWordCompat# i))+instance From Word16 Word64 where+    from (W16# i) = wordToWord64 (W# (word16ToWordCompat# i))+instance From Word16 Word128 where+    from (W16# i) = Word128 0 (wordToWord64 $ W# (word16ToWordCompat# i))+instance From Word16 Word256 where+    from (W16# i) = Word256 0 0 0 (wordToWord64 $ W# (word16ToWordCompat# i))+instance From Word16 Word where+    from (W16# i) = W# (word16ToWordCompat# i)+instance From Word16 Int32 where+    from (W16# w) = I32# (intToInt32Compat# (word2Int# (word16ToWordCompat# w)))+instance From Word16 Int64 where+    from (W16# w) = intToInt64 (I# (word2Int# (word16ToWordCompat# w)))+instance From Word16 Int where+    from (W16# w) = I# (word2Int# (word16ToWordCompat# w))++instance From Word32 Word64 where+    from (W32# i) = wordToWord64 (W# (word32ToWordCompat# i))+instance From Word32 Word128 where+    from (W32# i) = Word128 0 (wordToWord64 $ W# (word32ToWordCompat# i))+instance From Word32 Word256 where+    from (W32# i) = Word256 0 0 0 (wordToWord64 $ W# (word32ToWordCompat# i))+instance From Word32 Word where+    from (W32# i) = W# (word32ToWordCompat# i)+instance From Word32 Int64 where+    from (W32# w) = intToInt64 (I# (word2Int# (word32ToWordCompat# w)))+instance From Word32 Int where+    from (W32# w) = I# (word2Int# (word32ToWordCompat# w))++instance From Word64 Word128 where+    from w = Word128 0 w+instance From Word64 Word256 where+    from w = Word256 0 0 0 w++instance From Word Word64 where+    from = wordToWord64++-- Simple prelude types+instance From (Maybe a) (Either () a) where+    from (Just x) = Right x+    from Nothing  = Left ()++-- basic basement types+instance From (CountOf ty) Int where+    from (CountOf n) = n+instance From (CountOf ty) Word where+    -- here it is ok to cast the underlying `Int` held by `CountOf` to a `Word`+    -- as the `Int` should never hold a negative value.+    from (CountOf n) = cast n+instance From Word (Offset ty) where+    from w = Offset (cast w)+instance TryFrom Int (Offset ty) where+    tryFrom i+        | i < 0     = Nothing+        | otherwise = Just (Offset i)+instance TryFrom Int (CountOf ty) where+    tryFrom i+        | i < 0     = Nothing+        | otherwise = Just (CountOf i)+instance From Word (CountOf ty) where+    from w = CountOf (cast w)++instance From (Either a b) (These a b) where+    from (Left a) = This a+    from (Right b) = That b++instance From Word128 Word256 where+    from (Word128 a b) = Word256 0 0 a b++-- basement instances++-- uarrays+instance PrimType ty => From (Block.Block ty) (UArray.UArray ty) where+    from = UArray.fromBlock+instance PrimType ty => From (BoxArray.Array ty) (UArray.UArray ty) where+    from = BoxArray.mapToUnboxed id++-- blocks+instance PrimType ty => From (UArray.UArray ty) (Block.Block ty) where+    from = UArray.toBlock+instance PrimType ty => From (BoxArray.Array ty) (Block.Block ty) where+    from = UArray.toBlock . BoxArray.mapToUnboxed id++-- boxed array+instance PrimType ty => From (UArray.UArray ty) (BoxArray.Array ty) where+    from = BoxArray.mapFromUnboxed id+++instance From String.String (UArray.UArray Word8) where+    from = String.toBytes String.UTF8++instance From AsciiString.AsciiString String.String where+    from = String.fromBytesUnsafe . UArray.unsafeRecast . AsciiString.toBytes+instance From AsciiString.AsciiString (UArray.UArray Word8) where+    from = UArray.unsafeRecast . AsciiString.toBytes++instance TryFrom (UArray.UArray Word8) String.String where+    tryFrom arr = case String.fromBytes String.UTF8 arr of+                    (s, Nothing, _) -> Just s+                    (_, Just _, _)  -> Nothing++#if __GLASGOW_HASKELL__ >= 800+instance From (BlockN.BlockN n ty) (Block.Block ty) where+    from = BlockN.toBlock+instance (PrimType a, PrimType b, KnownNat n, KnownNat m, ((PrimSize b) Basement.Nat.* m) ~ ((PrimSize a) Basement.Nat.* n))+      => From (BlockN.BlockN n a) (BlockN.BlockN m b) where+    from = BlockN.cast+instance (NatWithinBound Int n, PrimType ty) => From (BlockN.BlockN n ty) (UArray.UArray ty) where+    from = UArray.fromBlock . BlockN.toBlock+instance (NatWithinBound Int n, PrimType ty) => From (BlockN.BlockN n ty) (BoxArray.Array ty) where+    from = BoxArray.mapFromUnboxed id . UArray.fromBlock . BlockN.toBlock++instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)+      => TryFrom (Block.Block ty) (BlockN.BlockN n ty) where+    tryFrom = BlockN.toBlockN+instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)+      => TryFrom (UArray.UArray ty) (BlockN.BlockN n ty) where+    tryFrom = BlockN.toBlockN . UArray.toBlock+instance (NatWithinBound (CountOf ty) n, KnownNat n, PrimType ty)+      => TryFrom (BoxArray.Array ty) (BlockN.BlockN n ty) where+    tryFrom = BlockN.toBlockN . UArray.toBlock . BoxArray.mapToUnboxed id++instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where+    from = narrow . unZn64 where narrow (W64# w) = W8# (narrow8WordCompat# (word64ToWord# w))+instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where+    from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16WordCompat# (word64ToWord# w))+instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where+    from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32WordCompat# (word64ToWord# w))+instance From (Zn64 n) Word64 where+    from = unZn64+instance From (Zn64 n) Word128 where+    from = from . unZn64+instance From (Zn64 n) Word256 where+    from = from . unZn64++instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where+    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (narrow8WordCompat# (word64ToWord# w))+instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where+    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16WordCompat# (word64ToWord# w))+instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where+    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32WordCompat# (word64ToWord# w))+instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) Word64 where+    from = naturalToWord64 . unZn+instance (KnownNat n, NatWithinBound Word128 n) => From (Zn n) Word128 where+    from = Word128.fromNatural . unZn+instance (KnownNat n, NatWithinBound Word256 n) => From (Zn n) Word256 where+    from = Word256.fromNatural . unZn++instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) (Zn64 n) where+    from = zn64 . naturalToWord64 . unZn+instance KnownNat n => From (Zn64 n) (Zn n) where+    from = zn . from . unZn64++naturalToWord64 :: Natural -> Word64+naturalToWord64 = Prelude.fromIntegral+#endif
+ Basement/HeadHackageUtils.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+module Basement.HeadHackageUtils where++import GHC.Exts++#if MIN_VERSION_base(4,16,0)+int8ToIntCompat# :: Int8# -> Int#+int8ToIntCompat# = int8ToInt#++int16ToIntCompat# :: Int16# -> Int#+int16ToIntCompat# = int16ToInt#++int32ToIntCompat# :: Int32# -> Int#+int32ToIntCompat# = int32ToInt#++word8ToWordCompat# :: Word8# -> Word#+word8ToWordCompat# = word8ToWord#++word16ToWordCompat# :: Word16# -> Word#+word16ToWordCompat# = word16ToWord#++word32ToWordCompat# :: Word32# -> Word#+word32ToWordCompat# = word32ToWord#++intToInt8Compat# :: Int# -> Int8#+intToInt8Compat# = intToInt8#++intToInt16Compat# :: Int# -> Int16#+intToInt16Compat# = intToInt16#++intToInt32Compat# :: Int# -> Int32#+intToInt32Compat# = intToInt32#++wordToWord8Compat# :: Word# -> Word8#+wordToWord8Compat# = wordToWord8#++wordToWord16Compat# :: Word# -> Word16#+wordToWord16Compat# = wordToWord16#++wordToWord32Compat# :: Word# -> Word32#+wordToWord32Compat# = wordToWord32#++--++narrow8IntCompat# :: Int# -> Int8#+narrow8IntCompat# = intToInt8#++narrow16IntCompat# :: Int# -> Int16#+narrow16IntCompat# = intToInt16#++narrow32IntCompat# :: Int# -> Int32#+narrow32IntCompat# = intToInt32#++narrow8WordCompat# :: Word# -> Word8#+narrow8WordCompat# = wordToWord8#++narrow16WordCompat# :: Word# -> Word16#+narrow16WordCompat# = wordToWord16#++narrow32WordCompat# :: Word# -> Word32#+narrow32WordCompat# = wordToWord32#+#else+-- No-ops+int8ToIntCompat# :: Int# -> Int#+int8ToIntCompat# x = x++int16ToIntCompat# :: Int# -> Int#+int16ToIntCompat# x = x++int32ToIntCompat# :: Int# -> Int#+int32ToIntCompat# x = x++word8ToWordCompat# :: Word# -> Word#+word8ToWordCompat# x = x++word16ToWordCompat# :: Word# -> Word#+word16ToWordCompat# x = x++word32ToWordCompat# :: Word# -> Word#+word32ToWordCompat# x = x++intToInt8Compat# :: Int# -> Int#+intToInt8Compat# x = x++intToInt16Compat# :: Int# -> Int#+intToInt16Compat# x = x++intToInt32Compat# :: Int# -> Int#+intToInt32Compat# x = x++wordToWord8Compat# :: Word# -> Word#+wordToWord8Compat# x = x++wordToWord16Compat# :: Word# -> Word#+wordToWord16Compat# x = x++wordToWord32Compat# :: Word# -> Word#+wordToWord32Compat# x = x++-- Actual narrowing+narrow8IntCompat# :: Int# -> Int#+narrow8IntCompat# = narrow8Int#++narrow16IntCompat# :: Int# -> Int#+narrow16IntCompat# = narrow16Int#++narrow32IntCompat# :: Int# -> Int#+narrow32IntCompat# = narrow32Int#++narrow8WordCompat# :: Word# -> Word#+narrow8WordCompat# = narrow8Word#++narrow16WordCompat# :: Word# -> Word#+narrow16WordCompat# = narrow16Word#++narrow32WordCompat# :: Word# -> Word#+narrow32WordCompat# = narrow32Word#+#endif
+ Basement/Imports.hs view
@@ -0,0 +1,125 @@+-- |+-- Module      : Basement.Imports+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- re-export of all the base prelude and basic primitive stuffs+{-# LANGUAGE CPP #-}+module Basement.Imports+    ( (Prelude.$)+    , (Prelude.$!)+    , (Prelude.&&)+    , (Prelude.||)+    , (Control.Category..)+    , (Control.Applicative.<$>)+    , Prelude.not+    , Prelude.otherwise+    , Prelude.fst+    , Prelude.snd+    , Control.Category.id+    , Prelude.maybe+    , Prelude.either+    , Prelude.flip+    , Prelude.const+    , Basement.Error.error+    , Prelude.and+    , Prelude.undefined+    , Prelude.seq+    , Prelude.Show+    , Basement.Show.show+    , Prelude.Ord (..)+    , Prelude.Eq (..)+    , Prelude.Bounded (..)+    , Prelude.Enum (..)+    , Prelude.Functor (..)+    , Control.Applicative.Applicative (..)+    , Prelude.Monad (..)+    , Control.Monad.when+    , Control.Monad.unless+    , Prelude.Maybe (..)+    , Prelude.Ordering (..)+    , Prelude.Bool (..)+    , Prelude.Int+    , Prelude.Integer+    , Basement.Compat.Natural.Natural+    , Basement.Types.OffsetSize.Offset+    , Basement.Types.OffsetSize.CountOf+    , Prelude.Char+    , Basement.PrimType.PrimType+    , Basement.Types.Char7.Char7+    , Basement.Types.AsciiString.AsciiString+    , Basement.UTF8.Base.String+    , Basement.UArray.UArray+    , Basement.BoxedArray.Array+    , Basement.Compat.NumLiteral.Integral (..)+    , Basement.Compat.NumLiteral.Fractional (..)+    , Basement.Compat.NumLiteral.HasNegation (..)+    , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64+    , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word+    , Prelude.Double, Prelude.Float+    , Prelude.IO+    , FP32+    , FP64+    , Basement.Compat.IsList.IsList (..)+    , GHC.Exts.IsString (..)+    , GHC.Generics.Generic (..)+    , Prelude.Either (..)+    , Data.Data.Data (..)+    , Data.Data.mkNoRepType+    , Data.Data.DataType+    , Data.Typeable.Typeable+    , Data.Monoid.Monoid (..)+#if MIN_VERSION_base(4,10,0)+    -- , (Basement.Compat.Semigroup.<>)+    , Basement.Compat.Semigroup.Semigroup(..)+#else+    , (Data.Monoid.<>)+    , Basement.Compat.Semigroup.Semigroup+#endif+    , Control.Exception.Exception+    , Control.Exception.throw+    , Control.Exception.throwIO+    , GHC.Ptr.Ptr(..)+    , ifThenElse+    ) where++import qualified Prelude+import qualified Control.Category+import qualified Control.Applicative+import qualified Control.Exception+import qualified Control.Monad+import qualified Data.Monoid+import qualified Data.Data+import qualified Data.Typeable+import qualified Data.Word+import qualified Data.Int+import qualified Basement.Compat.IsList+import qualified Basement.Compat.Natural+import qualified Basement.Compat.NumLiteral+import qualified Basement.Compat.Semigroup+import qualified Basement.UArray+import qualified Basement.BoxedArray+import qualified Basement.UTF8.Base+import qualified Basement.Error+import qualified Basement.Show+import qualified Basement.PrimType+import qualified Basement.Types.OffsetSize+import qualified Basement.Types.AsciiString+import qualified Basement.Types.Char7+import qualified GHC.Exts+import qualified GHC.Generics+import qualified GHC.Ptr+import           GHC.Exts (fromString)++-- | for support of if .. then .. else+ifThenElse :: Prelude.Bool -> a -> a -> a+ifThenElse Prelude.True  e1 _  = e1+ifThenElse Prelude.False _  e2 = e2++-- | IEEE754 Floating point Binary32, simple precision (Also known as Float)+type FP32 = Prelude.Float++-- | IEEE754 Floating point Binary64, double precision (Also known as Double)+type FP64 = Prelude.Double
+ Basement/IntegralConv.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE MagicHash             #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE UnboxedTuples         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+module Basement.IntegralConv+    ( IntegralDownsize(..)+    , IntegralUpsize(..)+    , intToInt64+    , int64ToInt+    , wordToWord64+    , word64ToWord32s+    , Word32x2(..)+    , word64ToWord+    , wordToChar+    , wordToInt+    , charToInt+    ) where++import GHC.Types+import GHC.Prim+#if __GLASGOW_HASKELL__ >= 903+  hiding (word64ToWord#)+#endif+import GHC.Int+import GHC.Word+import Prelude (Integer, fromIntegral)+import Basement.Compat.Base+import Basement.Compat.Natural+import Basement.HeadHackageUtils+import Basement.Numerical.Number+import Basement.Numerical.Conversion++-- | Downsize an integral value+class IntegralDownsize a b where+    integralDownsize :: a -> b+    default integralDownsize :: a ~ b => a -> b+    integralDownsize = id++    integralDownsizeCheck :: a -> Maybe b++-- | Upsize an integral value+--+-- The destination type 'b' size need to be greater or equal+-- than the size type of 'a'+class IntegralUpsize a b where+    integralUpsize      :: a -> b++integralDownsizeBounded :: forall a b . (Ord a, Bounded b, IntegralDownsize a b, IntegralUpsize b a)+                        => (a -> b)+                        -> a+                        -> Maybe b+integralDownsizeBounded aToB x+    | x < integralUpsize (minBound :: b) && x > integralUpsize (maxBound :: b) = Nothing+    | otherwise                                                                = Just (aToB x)++instance IsIntegral a => IntegralUpsize a Integer where+    integralUpsize = toInteger+instance IsNatural a => IntegralUpsize a Natural where+    integralUpsize = toNatural++instance IntegralUpsize Int8 Int16 where+    integralUpsize (I8# i) = I16# (intToInt16Compat# (int8ToIntCompat# i))+instance IntegralUpsize Int8 Int32 where+    integralUpsize (I8# i) = I32# (intToInt32Compat# (int8ToIntCompat# i))+instance IntegralUpsize Int8 Int64 where+    integralUpsize (I8# i) = intToInt64 (I# (int8ToIntCompat# i))+instance IntegralUpsize Int8 Int where+    integralUpsize (I8# i) = I# (int8ToIntCompat# i)++instance IntegralUpsize Int16 Int32 where+    integralUpsize (I16# i) = I32# (intToInt32Compat# (int16ToIntCompat# i))+instance IntegralUpsize Int16 Int64 where+    integralUpsize (I16# i) = intToInt64 (I# (int16ToIntCompat# i))+instance IntegralUpsize Int16 Int where+    integralUpsize (I16# i) = I# (int16ToIntCompat# i)++instance IntegralUpsize Int32 Int64 where+    integralUpsize (I32# i) = intToInt64 (I# (int32ToIntCompat# i))+instance IntegralUpsize Int32 Int where+    integralUpsize (I32# i) = I# (int32ToIntCompat# i)++instance IntegralUpsize Int Int64 where+    integralUpsize = intToInt64++instance IntegralUpsize Word8 Word16 where+    integralUpsize (W8# i) = W16# (wordToWord16Compat# (word8ToWordCompat# i))+instance IntegralUpsize Word8 Word32 where+    integralUpsize (W8# i) = W32# (wordToWord32Compat# (word8ToWordCompat# i))+instance IntegralUpsize Word8 Word64 where+    integralUpsize (W8# i) = wordToWord64 (W# (word8ToWordCompat# i))+instance IntegralUpsize Word8 Word where+    integralUpsize (W8# i) = W# (word8ToWordCompat# i)+instance IntegralUpsize Word8 Int16 where+    integralUpsize (W8# w) = I16# (intToInt16Compat# (word2Int# (word8ToWordCompat# w)))+instance IntegralUpsize Word8 Int32 where+    integralUpsize (W8# w) = I32# (intToInt32Compat# (word2Int# (word8ToWordCompat# w)))+instance IntegralUpsize Word8 Int64 where+    integralUpsize (W8# w) = intToInt64 (I# (word2Int# (word8ToWordCompat# w)))+instance IntegralUpsize Word8 Int where+    integralUpsize (W8# w) = I# (word2Int# (word8ToWordCompat# w))++instance IntegralUpsize Word16 Word32 where+    integralUpsize (W16# i) = W32# (wordToWord32Compat# (word16ToWordCompat# i))+instance IntegralUpsize Word16 Word64 where+    integralUpsize (W16# i) = wordToWord64 (W# (word16ToWordCompat# i))+instance IntegralUpsize Word16 Word where+    integralUpsize (W16# i) = W# (word16ToWordCompat# i)++instance IntegralUpsize Word32 Word64 where+    integralUpsize (W32# i) = wordToWord64 (W# (word32ToWordCompat# i))+instance IntegralUpsize Word32 Word where+    integralUpsize (W32# i) = W# (word32ToWordCompat# i)++instance IntegralUpsize Word Word64 where+    integralUpsize = wordToWord64++instance IntegralDownsize Int Int8 where+    integralDownsize      (I# i) = I8# (narrow8IntCompat# i)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Int Int16 where+    integralDownsize      (I# i) = I16# (narrow16IntCompat# i)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Int Int32 where+    integralDownsize      (I# i) = I32# (narrow32IntCompat# i)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Int64 Int8 where+    integralDownsize      i = integralDownsize (int64ToInt i)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Int64 Int16 where+    integralDownsize      i = integralDownsize (int64ToInt i)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Int64 Int32 where+    integralDownsize      i = integralDownsize (int64ToInt i)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Int64 Int where+    integralDownsize      i = int64ToInt i+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Word64 Word8 where+    integralDownsize      (W64# i) = W8# (narrow8WordCompat# (word64ToWord# i))+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Word64 Word16 where+    integralDownsize      (W64# i) = W16# (narrow16WordCompat# (word64ToWord# i))+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Word64 Word32 where+    integralDownsize      (W64# i) = W32# (narrow32WordCompat# (word64ToWord# i))+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Word Word8 where+    integralDownsize (W# w) = W8# (narrow8WordCompat# w)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Word Word16 where+    integralDownsize (W# w) = W16# (narrow16WordCompat# w)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Word Word32 where+    integralDownsize (W# w) = W32# (narrow32WordCompat# w)+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Word32 Word8 where+    integralDownsize      (W32# i) = W8# (narrow8WordCompat# (word32ToWordCompat# i))+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Word32 Word16 where+    integralDownsize      (W32# i) = W16# (narrow16WordCompat# (word32ToWordCompat# i))+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Word16 Word8 where+    integralDownsize      (W16# i) = W8# (narrow8WordCompat# (word16ToWordCompat# i))+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Integer Int8 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Int16 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Int32 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Int64 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize++instance IntegralDownsize Integer Word8 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Word16 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Word32 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Word64 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Integer Natural where+    integralDownsize i+        | i >= 0    = fromIntegral i+        | otherwise = 0+    integralDownsizeCheck i+        | i >= 0    = Just (fromIntegral i)+        | otherwise = Nothing++instance IntegralDownsize Natural Word8 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Natural Word16 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Natural Word32 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize+instance IntegralDownsize Natural Word64 where+    integralDownsize = fromIntegral+    integralDownsizeCheck = integralDownsizeBounded integralDownsize
+ Basement/Monad.hs view
@@ -0,0 +1,138 @@+-- |+-- Module      : Basement.Monad+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Allow to run operation in ST and IO, without having to+-- distinguinsh between the two. Most operations exposes+-- the bare nuts and bolts of how IO and ST actually+-- works, and relatively easy to shoot yourself in the foot+--+-- this is highly similar to the Control.Monad.Primitive+-- in the primitive package+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ConstraintKinds #-}+module Basement.Monad+    ( PrimMonad(..)+    , MonadFailure(..)+    , unPrimMonad_+    , unsafePrimCast+    , unsafePrimToST+    , unsafePrimToIO+    , unsafePrimFromIO+    , primTouch+    ) where++import qualified Prelude+import           GHC.ST+import           GHC.STRef+import           GHC.IORef+import           GHC.IO+import           GHC.Prim+import           Basement.Compat.Base (Exception, (.), ($), Applicative, Monad)+import           Basement.Compat.Primitive++-- | Primitive monad that can handle mutation.+--+-- For example: IO and ST.+class (Prelude.Functor m, Applicative m, Prelude.Monad m) => PrimMonad m where+    -- | type of state token associated with the PrimMonad m+    type PrimState m+    -- | type of variable associated with the PrimMonad m+    type PrimVar m :: * -> *+    -- | Unwrap the State# token to pass to a function a primitive function that returns an unboxed state and a value.+    primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a+    -- | Throw Exception in the primitive monad+    primThrow :: Exception e => e -> m a+    -- | Run a Prim monad from a dedicated state#+    unPrimMonad  :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #)++    -- | Build a new variable in the Prim Monad+    primVarNew :: a -> m (PrimVar m a)+    -- | Read the variable in the Prim Monad+    primVarRead :: PrimVar m a -> m a+    -- | Write the variable in the Prim Monad+    primVarWrite :: PrimVar m a -> a -> m ()++-- | just like `unwrapPrimMonad` but throw away the result and return just the new State#+unPrimMonad_ :: PrimMonad m => m () -> State# (PrimState m) -> State# (PrimState m)+unPrimMonad_ p st =+    case unPrimMonad p st of+        (# st', () #) -> st'+{-# INLINE unPrimMonad_ #-}++instance PrimMonad IO where+    type PrimState IO = RealWorld+    type PrimVar IO = IORef+    primitive = IO+    {-# INLINE primitive #-}+    primThrow = throwIO+    unPrimMonad (IO p) = p+    {-# INLINE unPrimMonad #-}+    primVarNew = newIORef+    primVarRead = readIORef+    primVarWrite = writeIORef++instance PrimMonad (ST s) where+    type PrimState (ST s) = s+    type PrimVar (ST s) = STRef s+    primitive = ST+    {-# INLINE primitive #-}+    primThrow = unsafeIOToST . throwIO+    unPrimMonad (ST p) = p+    {-# INLINE unPrimMonad #-}+    primVarNew = newSTRef+    primVarRead = readSTRef+    primVarWrite = writeSTRef++-- | Convert a prim monad to another prim monad.+--+-- The net effect is that it coerce the state repr to another,+-- so the runtime representation should be the same, otherwise+-- hilary ensues.+unsafePrimCast :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a+unsafePrimCast m = primitive (unsafeCoerce# (unPrimMonad m))+{-# INLINE unsafePrimCast #-}++-- | Convert any prim monad to an ST monad+unsafePrimToST :: PrimMonad prim => prim a -> ST s a+unsafePrimToST = unsafePrimCast+{-# INLINE unsafePrimToST #-}++-- | Convert any prim monad to an IO monad+unsafePrimToIO :: PrimMonad prim => prim a -> IO a+unsafePrimToIO = unsafePrimCast+{-# INLINE unsafePrimToIO #-}++-- | Convert any IO monad to a prim monad+unsafePrimFromIO :: PrimMonad prim => IO a -> prim a+unsafePrimFromIO = unsafePrimCast+{-# INLINE unsafePrimFromIO #-}++-- | Touch primitive lifted to any prim monad+primTouch :: PrimMonad m => a -> m ()+primTouch x = unsafePrimFromIO $ primitive $ \s -> case touch# x s of { s2 -> (# s2, () #) }+{-# INLINE primTouch #-}++-- | Monad that can represent failure+--+-- Similar to MonadFail but with a parametrized Failure linked to the Monad+class Monad m => MonadFailure m where+    -- | The associated type with the MonadFailure, representing what+    -- failure can be encoded in this monad+    type Failure m++    -- | Raise a Failure through a monad.+    mFail :: Failure m -> m ()++instance MonadFailure Prelude.Maybe where+    type Failure Prelude.Maybe = ()+    mFail _ = Prelude.Nothing+instance MonadFailure (Prelude.Either a) where+    type Failure (Prelude.Either a) = a+    mFail a = Prelude.Left a
+ Basement/MutableBuilder.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Basement.MutableBuilder+    ( Builder(..)+    , BuildingState(..)+    ) where++import           Basement.Compat.Base+import           Basement.Compat.MonadTrans+import           Basement.Types.OffsetSize+import           Basement.Monad++newtype Builder collection mutCollection step state err a = Builder+    { runBuilder :: State (Offset step, BuildingState collection mutCollection step (PrimState state), Maybe err) state a }+    deriving (Functor, Applicative, Monad)++-- | The in-progress state of a building operation.+--+-- The previous buffers are in reverse order, and+-- this contains the current buffer and the state of+-- progress packing the elements inside.+data BuildingState collection mutCollection step state = BuildingState+    { prevChunks     :: [collection]+    , prevChunksSize :: !(CountOf step)+    , curChunk       :: mutCollection state+    , chunkSize      :: !(CountOf step)+    }++instance Monad state => MonadFailure (Builder collection mutCollection step state err) where+    type Failure (Builder collection mutCollection step state err) = err+    mFail builderError = Builder $ State $ \(offset, bs, _)  ->+        return ((), (offset, bs, Just builderError))
+ Basement/Nat.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE ConstraintKinds           #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE NoStarIsType              #-}+#endif+module Basement.Nat+    ( Nat+    , KnownNat+    , natVal+    , type (<=), type (<=?), type (+), type (*), type (^), type (-)+    , CmpNat+    -- * Nat convertion+    , natValNatural+    , natValInt+    , natValInt8+    , natValInt16+    , natValInt32+    , natValInt64+    , natValWord+    , natValWord8+    , natValWord16+    , natValWord32+    , natValWord64+    -- * Maximum bounds+    , NatNumMaxBound+    -- * Constraint+    , NatInBoundOf+    , NatWithinBound+    ) where++#include "MachDeps.h"++import           GHC.TypeLits+import           Basement.Compat.Base+import           Basement.Compat.Natural+import           Basement.Types.Char7 (Char7)+import           Basement.Types.Word128 (Word128)+import           Basement.Types.Word256 (Word256)+import           Data.Int (Int8, Int16, Int32, Int64)+import           Data.Word (Word8, Word16, Word32, Word64)+import qualified Prelude (fromIntegral)++#if __GLASGOW_HASKELL__ >= 800+import           Data.Type.Bool+#endif++natValNatural :: forall n proxy . KnownNat n => proxy n -> Natural+natValNatural n = Prelude.fromIntegral (natVal n)++natValInt :: forall n proxy . (KnownNat n, NatWithinBound Int n) => proxy n -> Int+natValInt n = Prelude.fromIntegral (natVal n)++natValInt64 :: forall n proxy . (KnownNat n, NatWithinBound Int64 n) => proxy n -> Int64+natValInt64 n = Prelude.fromIntegral (natVal n)++natValInt32 :: forall n proxy . (KnownNat n, NatWithinBound Int32 n) => proxy n -> Int32+natValInt32 n = Prelude.fromIntegral (natVal n)++natValInt16 :: forall n proxy . (KnownNat n, NatWithinBound Int16 n) => proxy n -> Int16+natValInt16 n = Prelude.fromIntegral (natVal n)++natValInt8 :: forall n proxy . (KnownNat n, NatWithinBound Int8 n) => proxy n -> Int8+natValInt8 n = Prelude.fromIntegral (natVal n)++natValWord :: forall n proxy . (KnownNat n, NatWithinBound Word n) => proxy n -> Word+natValWord n = Prelude.fromIntegral (natVal n)++natValWord64 :: forall n proxy . (KnownNat n, NatWithinBound Word64 n) => proxy n -> Word64+natValWord64 n = Prelude.fromIntegral (natVal n)++natValWord32 :: forall n proxy . (KnownNat n, NatWithinBound Word32 n) => proxy n -> Word32+natValWord32 n = Prelude.fromIntegral (natVal n)++natValWord16 :: forall n proxy . (KnownNat n, NatWithinBound Word16 n) => proxy n -> Word16+natValWord16 n = Prelude.fromIntegral (natVal n)++natValWord8 :: forall n proxy . (KnownNat n, NatWithinBound Word8 n) => proxy n -> Word8+natValWord8 n = Prelude.fromIntegral (natVal n)++-- | Get Maximum bounds of different Integral / Natural types related to Nat+type family NatNumMaxBound ty :: Nat++type instance NatNumMaxBound Char   = 0x10ffff+type instance NatNumMaxBound Char7  = 0x7f+type instance NatNumMaxBound Int64  = 0x7fffffffffffffff+type instance NatNumMaxBound Int32  = 0x7fffffff+type instance NatNumMaxBound Int16  = 0x7fff+type instance NatNumMaxBound Int8   = 0x7f+type instance NatNumMaxBound Word256 = 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff+type instance NatNumMaxBound Word128 = 0xffffffffffffffffffffffffffffffff+type instance NatNumMaxBound Word64 = 0xffffffffffffffff+type instance NatNumMaxBound Word32 = 0xffffffff+type instance NatNumMaxBound Word16 = 0xffff+type instance NatNumMaxBound Word8  = 0xff+#if WORD_SIZE_IN_BITS == 64+type instance NatNumMaxBound Int    = NatNumMaxBound Int64+type instance NatNumMaxBound Word   = NatNumMaxBound Word64+#else+type instance NatNumMaxBound Int    = NatNumMaxBound Int32+type instance NatNumMaxBound Word   = NatNumMaxBound Word32+#endif++-- | Check if a Nat is in bounds of another integral / natural types+type family NatInBoundOf ty n where+    NatInBoundOf Integer n = 'True+    NatInBoundOf Natural n = 'True+    NatInBoundOf ty      n = n <=? NatNumMaxBound ty++-- | Constraint to check if a natural is within a specific bounds of a type.+--+-- i.e. given a Nat `n`, is it possible to convert it to `ty` without losing information+#if __GLASGOW_HASKELL__ >= 800+type family NatWithinBound ty (n :: Nat) where+    NatWithinBound ty n = If (NatInBoundOf ty n)+        (() ~ ())+        (TypeError ('Text "Natural " ':<>: 'ShowType n ':<>: 'Text " is out of bounds for " ':<>: 'ShowType ty))+#else+type NatWithinBound ty n = NatInBoundOf ty n ~ 'True+#endif
+ Basement/NonEmpty.hs view
@@ -0,0 +1,25 @@+-- |+-- Module      : Basement.NonEmpty+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+-- A newtype wrapper around a non-empty Collection.++module Basement.NonEmpty+    ( NonEmpty(..)+    ) where++import           Basement.Exception+import           Basement.Compat.Base++-- | NonEmpty property for any Collection+newtype NonEmpty a = NonEmpty { getNonEmpty :: a }+    deriving (Show,Eq)++instance IsList c => IsList (NonEmpty c) where+    type Item (NonEmpty c) = Item c+    toList      = toList . getNonEmpty+    fromList [] = throw NonEmptyCollectionIsEmpty+    fromList l  = NonEmpty . fromList $ l
+ Basement/NormalForm.hs view
@@ -0,0 +1,131 @@+module Basement.NormalForm+    ( NormalForm(..)+    , deepseq+    , force+    ) where++import Basement.Compat.Base+import Basement.Compat.C.Types+import Basement.Compat.Natural+import Basement.Types.OffsetSize+import Basement.Types.Char7+import Basement.Types.Word128 (Word128)+import Basement.Types.Word256 (Word256)+import Basement.Bounded+import Basement.Endianness++-- | Data that can be fully evaluated in Normal Form+--+class NormalForm a where+    toNormalForm :: a -> ()++deepseq :: NormalForm a => a -> b -> b+deepseq a b = toNormalForm a `seq` b++force :: NormalForm a => a -> a+force a = toNormalForm a `seq` a++-----+-- GHC / base types++instance NormalForm Int8    where toNormalForm !_ = ()+instance NormalForm Int16   where toNormalForm !_ = ()+instance NormalForm Int32   where toNormalForm !_ = ()+instance NormalForm Int64   where toNormalForm !_ = ()+instance NormalForm Int     where toNormalForm !_ = ()+instance NormalForm Integer where toNormalForm !_ = ()++instance NormalForm Word8   where toNormalForm !_ = ()+instance NormalForm Word16  where toNormalForm !_ = ()+instance NormalForm Word32  where toNormalForm !_ = ()+instance NormalForm Word64  where toNormalForm !_ = ()+instance NormalForm Word    where toNormalForm !_ = ()+instance NormalForm Natural where toNormalForm !_ = ()++instance NormalForm Float  where toNormalForm !_ = ()+instance NormalForm Double where toNormalForm !_ = ()++instance NormalForm Char where toNormalForm !_ = ()+instance NormalForm Bool where toNormalForm !_ = ()+instance NormalForm ()   where toNormalForm !_ = ()++-----+-- C Types+instance NormalForm CChar  where toNormalForm !_ = ()+instance NormalForm CUChar where toNormalForm !_ = ()+instance NormalForm CSChar where toNormalForm !_ = ()++instance NormalForm CShort  where toNormalForm !_ = ()+instance NormalForm CUShort where toNormalForm !_ = ()+instance NormalForm CInt    where toNormalForm !_ = ()+instance NormalForm CUInt   where toNormalForm !_ = ()+instance NormalForm CLong   where toNormalForm !_ = ()+instance NormalForm CULong  where toNormalForm !_ = ()+instance NormalForm CLLong  where toNormalForm !_ = ()+instance NormalForm CULLong where toNormalForm !_ = ()++instance NormalForm CFloat  where toNormalForm !_ = ()+instance NormalForm CDouble where toNormalForm !_ = ()++instance NormalForm (Ptr a) where toNormalForm !_ = ()++-----+-- Basic Foundation primitive types+instance NormalForm (Offset a) where toNormalForm !_ = ()+instance NormalForm (CountOf a) where toNormalForm !_ = ()++instance NormalForm Char7 where toNormalForm !_ = ()+instance NormalForm Word128 where toNormalForm !_ = ()+instance NormalForm Word256 where toNormalForm !_ = ()+instance NormalForm (Zn n) where toNormalForm = toNormalForm . unZn+instance NormalForm (Zn64 n) where toNormalForm = toNormalForm . unZn64++-----+-- composed type++instance NormalForm a => NormalForm (Maybe a) where+    toNormalForm Nothing  = ()+    toNormalForm (Just a) = toNormalForm a `seq` ()+instance (NormalForm l, NormalForm r) => NormalForm (Either l r) where+    toNormalForm (Left l)  = toNormalForm l `seq` ()+    toNormalForm (Right r) = toNormalForm r `seq` ()+instance NormalForm a => NormalForm (LE a) where+    toNormalForm (LE a) = toNormalForm a `seq` ()+instance NormalForm a => NormalForm (BE a) where+    toNormalForm (BE a) = toNormalForm a `seq` ()++instance NormalForm a => NormalForm [a] where+    toNormalForm []     = ()+    toNormalForm (x:xs) = toNormalForm x `seq` toNormalForm xs++instance (NormalForm a, NormalForm b) => NormalForm (a,b) where+    toNormalForm (a,b) = toNormalForm a `seq` toNormalForm b++instance (NormalForm a, NormalForm b, NormalForm c) => NormalForm (a,b,c) where+    toNormalForm (a,b,c) = toNormalForm a `seq` toNormalForm b `seq` toNormalForm c++instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d) => NormalForm (a,b,c,d) where+    toNormalForm (a,b,c,d) = toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d++instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d, NormalForm e)+      => NormalForm (a,b,c,d,e) where+    toNormalForm (a,b,c,d,e) =+        toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d `seq`+        toNormalForm e++instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d, NormalForm e, NormalForm f)+      => NormalForm (a,b,c,d,e,f) where+    toNormalForm (a,b,c,d,e,f) =+        toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d `seq`+        toNormalForm e `seq` toNormalForm f++instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d, NormalForm e, NormalForm f, NormalForm g)+      => NormalForm (a,b,c,d,e,f,g) where+    toNormalForm (a,b,c,d,e,f,g) =+        toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d `seq`+        toNormalForm e `seq` toNormalForm f `seq` toNormalForm g+instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d, NormalForm e, NormalForm f, NormalForm g, NormalForm h)+      => NormalForm (a,b,c,d,e,f,g,h) where+    toNormalForm (a,b,c,d,e,f,g,h) =+        toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d `seq`+        toNormalForm e `seq` toNormalForm f `seq` toNormalForm g `seq` toNormalForm h
+ Basement/Numerical/Additive.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash         #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DefaultSignatures #-}+{-# OPTIONS_GHC -fno-prof-auto #-}+module Basement.Numerical.Additive+    ( Additive(..)+    ) where++#include "MachDeps.h"++import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Compat.Natural+import           Basement.Numerical.Number+import qualified Prelude+import           GHC.Types+import           GHC.Prim+import           GHC.Int+import           GHC.Word+import           Basement.Bounded+import           Basement.HeadHackageUtils+import           Basement.Nat+import           Basement.Types.Word128 (Word128)+import           Basement.Types.Word256 (Word256)+import qualified Basement.Types.Word128 as Word128+import qualified Basement.Types.Word256 as Word256++#if WORD_SIZE_IN_BITS < 64+import           GHC.IntWord64+#endif++-- | Represent class of things that can be added together,+-- contains a neutral element and is commutative.+--+-- > x + azero = x+-- > azero + x = x+-- > x + y = y + x+--+class Additive a where+    {-# MINIMAL azero, (+) #-}+    azero :: a           -- the identity element over addition+    (+)   :: a -> a -> a -- the addition++    scale :: IsNatural n => n -> a -> a -- scale: repeated addition+    default scale :: (Enum n, IsNatural n) => n -> a -> a+    scale = scaleEnum++scaleEnum :: (Enum n, IsNatural n, Additive a) => n -> a -> a+scaleEnum 0 _ = azero+scaleEnum 1 a = a+scaleEnum 2 a = a + a+scaleEnum n a = a + scaleEnum (pred n) a -- TODO optimise. define by group of 2.++infixl 6 +++instance Additive Integer where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Int where+    azero = 0+    (I# a) + (I# b) = I# (a +# b)+    scale = scaleNum+instance Additive Int8 where+    azero = 0+    (I8# a) + (I8# b) = I8# (narrow8IntCompat# (int8ToIntCompat# a +# int8ToIntCompat# b))+    scale = scaleNum+instance Additive Int16 where+    azero = 0+    (I16# a) + (I16# b) = I16# (narrow16IntCompat# (int16ToIntCompat# a +# int16ToIntCompat# b))+    scale = scaleNum+instance Additive Int32 where+    azero = 0+    (I32# a) + (I32# b) = I32# (narrow32IntCompat# (int32ToIntCompat# a +# int32ToIntCompat# b))+    scale = scaleNum+instance Additive Int64 where+    azero = 0+#if WORD_SIZE_IN_BITS == 64+    (I64# a) + (I64# b) = I64# (a +# b)+#else+    (I64# a) + (I64# b) = I64# (a `plusInt64#` b)+#endif+    scale = scaleNum+instance Additive Word where+    azero = 0+    (W# a) + (W# b) = W# (a `plusWord#` b)+    scale = scaleNum+instance Additive Natural where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Word8 where+    azero = 0+    (W8# a) + (W8# b) = W8# (narrow8WordCompat# (word8ToWordCompat# a `plusWord#` word8ToWordCompat# b))+    scale = scaleNum+instance Additive Word16 where+    azero = 0+    (W16# a) + (W16# b) = W16# (narrow16WordCompat# (word16ToWordCompat# a `plusWord#` word16ToWordCompat# b))+    scale = scaleNum+instance Additive Word32 where+    azero = 0+    (W32# a) + (W32# b) = W32# (narrow32WordCompat# (word32ToWordCompat# a `plusWord#` word32ToWordCompat# b))+    scale = scaleNum+instance Additive Word64 where+    azero = 0+#if WORD_SIZE_IN_BITS == 64+    (W64# a) + (W64# b) = W64# (a `plusWord#` b)+#else+    (W64# a) + (W64# b) = W64# (int64ToWord64# (word64ToInt64# a `plusInt64#` word64ToInt64# b))+#endif+    scale = scaleNum+instance Additive Word128 where+    azero = 0+    (+) = (Word128.+)+    scale = scaleNum+instance Additive Word256 where+    azero = 0+    (+) = (Word256.+)+    scale = scaleNum++instance Additive Prelude.Float where+    azero = 0.0+    (F# a) + (F# b) = F# (a `plusFloat#` b)+    scale = scaleNum+instance Additive Prelude.Double where+    azero = 0.0+    (D# a) + (D# b) = D# (a +## b)+    scale = scaleNum+instance Additive Prelude.Rational where+    azero = 0.0+    (+) = (Prelude.+)+    scale = scaleNum++instance (KnownNat n, NatWithinBound Word64 n) => Additive (Zn64 n) where+    azero = zn64 0+    (+) = (Prelude.+)+    scale = scaleNum+instance KnownNat n => Additive (Zn n) where+    azero = zn 0+    (+) = (Prelude.+)+    scale = scaleNum++instance Additive CChar where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CSChar where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CUChar where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CShort where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CUShort where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CInt where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CUInt where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CLong where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CULong where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CPtrdiff where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CSize where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CWchar where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CSigAtomic where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CLLong where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CULLong where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CIntPtr where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CUIntPtr where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CIntMax where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CUIntMax where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CClock where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CTime where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CUSeconds where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CSUSeconds where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive COff where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum++instance Additive CFloat where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive CDouble where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum++scaleNum :: (Prelude.Num a, IsNatural n) => n -> a -> a+scaleNum n a = (Prelude.fromIntegral $ toNatural n) Prelude.* a
+ Basement/Numerical/Conversion.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE MagicHash             #-}+module Basement.Numerical.Conversion+    ( intToInt64+    , int64ToInt+    , intToWord+    , wordToWord64+    , word64ToWord+    , Word32x2(..)+    , word64ToWord32s+    , wordToChar+    , wordToInt+    , word64ToWord#+    , charToInt+    , int64ToWord64+    , word64ToInt64+    ) where++#include "MachDeps.h"++import Basement.HeadHackageUtils+import GHC.Types+import GHC.Prim+#if __GLASGOW_HASKELL__ >= 903+  hiding (word64ToWord#)+#endif+import GHC.Int+import GHC.Word++#if WORD_SIZE_IN_BITS < 64+import GHC.IntWord64+#endif++intToInt64 :: Int -> Int64+#if WORD_SIZE_IN_BITS == 64+intToInt64 (I# i) = I64# i+#else+intToInt64 (I# i) = I64# (intToInt64# i)+#endif++int64ToInt :: Int64 -> Int+#if WORD_SIZE_IN_BITS == 64+int64ToInt (I64# i) = I# i+#else+int64ToInt (I64# i) = I# (int64ToInt# i)+#endif++wordToWord64 :: Word -> Word64+#if WORD_SIZE_IN_BITS == 64+wordToWord64 (W# i) = W64# i+#else+wordToWord64 (W# i) = W64# (wordToWord64# i)+#endif++word64ToWord :: Word64 -> Word+#if WORD_SIZE_IN_BITS == 64+word64ToWord (W64# i) = W# i+#else+word64ToWord (W64# i) = W# (word64ToWord# i)+#endif++word64ToInt64 :: Word64 -> Int64+#if WORD_SIZE_IN_BITS == 64+word64ToInt64 (W64# i) = I64# (word2Int# i)+#else+word64ToInt64 (W64# i) = I64# (word64ToInt64# i)+#endif++int64ToWord64 :: Int64 -> Word64+#if WORD_SIZE_IN_BITS == 64+int64ToWord64 (I64# i) = W64# (int2Word# i)+#else+int64ToWord64 (I64# i) = W64# (int64ToWord64# i)+#endif++#if WORD_SIZE_IN_BITS == 64+word64ToWord# :: Word# -> Word#+word64ToWord# i = i+{-# INLINE word64ToWord# #-}+#endif++-- | 2 Word32s+data Word32x2 = Word32x2 {-# UNPACK #-} !Word32+                         {-# UNPACK #-} !Word32++#if WORD_SIZE_IN_BITS == 64+word64ToWord32s :: Word64 -> Word32x2+word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32Compat# (uncheckedShiftRL# w64 32#))) (W32# (narrow32WordCompat# w64))+#else+word64ToWord32s :: Word64 -> Word32x2+word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64))+#endif++wordToChar :: Word -> Char+wordToChar (W# word) = C# (chr# (word2Int# word))++wordToInt :: Word -> Int+wordToInt (W# word) = I# (word2Int# word)++intToWord :: Int -> Word+intToWord (I# i) = W# (int2Word# i)++charToInt :: Char -> Int+charToInt (C# x) = I# (ord# x)
+ Basement/Numerical/Multiplicative.hs view
@@ -0,0 +1,326 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DefaultSignatures #-}+module Basement.Numerical.Multiplicative+    ( Multiplicative(..)+    , IDivisible(..)+    , Divisible(..)+    , recip+    ) where++import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Compat.Natural+import           Basement.Compat.NumLiteral+import           Basement.Numerical.Number+import           Basement.Numerical.Additive+import           Basement.Types.Word128 (Word128)+import           Basement.Types.Word256 (Word256)+import qualified Basement.Types.Word128 as Word128+import qualified Basement.Types.Word256 as Word256+import qualified Prelude++-- | Represent class of things that can be multiplied together+--+-- > x * midentity = x+-- > midentity * x = x+class Multiplicative a where+    {-# MINIMAL midentity, (*) #-}+    -- | Identity element over multiplication+    midentity :: a++    -- | Multiplication of 2 elements that result in another element+    (*) :: a -> a -> a++    -- | Raise to power, repeated multiplication+    -- e.g.+    -- > a ^ 2 = a * a+    -- > a ^ 10 = (a ^ 5) * (a ^ 5) ..+    --(^) :: (IsNatural n) => a -> n -> a+    (^) :: (IsNatural n, Enum n, IDivisible n) => a -> n -> a+    (^) = power++-- | Represent types that supports an euclidian division+--+-- > (x ‘div‘ y) * y + (x ‘mod‘ y) == x+class (Additive a, Multiplicative a) => IDivisible a where+    {-# MINIMAL (div, mod) | divMod #-}+    div :: a -> a -> a+    div a b = fst $ divMod a b+    mod :: a -> a -> a+    mod a b = snd $ divMod a b+    divMod :: a -> a -> (a, a)+    divMod a b = (div a b, mod a b)++-- | Support for division between same types+--+-- This is likely to change to represent specific mathematic divisions+class Multiplicative a => Divisible a where+    {-# MINIMAL (/) #-}+    (/) :: a -> a -> a++infixl 7  *, /+infixr 8  ^++instance Multiplicative Integer where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Int where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Int8 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Int16 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Int32 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Int64 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Natural where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Word where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Word8 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Word16 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Word32 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Word64 where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative Word128 where+    midentity = 1+    (*) = (Word128.*)+instance Multiplicative Word256 where+    midentity = 1+    (*) = (Word256.*)++instance Multiplicative Prelude.Float where+    midentity = 1.0+    (*) = (Prelude.*)+instance Multiplicative Prelude.Double where+    midentity = 1.0+    (*) = (Prelude.*)+instance Multiplicative Prelude.Rational where+    midentity = 1.0+    (*) = (Prelude.*)++instance Multiplicative CChar where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CSChar where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CUChar where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CShort where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CUShort where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CInt where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CUInt where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CLong where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CULong where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CPtrdiff where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CSize where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CWchar where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CSigAtomic where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CLLong where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CULLong where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CIntPtr where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CUIntPtr where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CIntMax where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CUIntMax where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CClock where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CTime where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CUSeconds where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative CSUSeconds where+    midentity = 1+    (*) = (Prelude.*)+instance Multiplicative COff where+    midentity = 1+    (*) = (Prelude.*)++instance Multiplicative CFloat where+    midentity = 1.0+    (*) = (Prelude.*)+instance Multiplicative CDouble where+    midentity = 1.0+    (*) = (Prelude.*)++instance IDivisible Integer where+    div = Prelude.div+    mod = Prelude.mod+instance IDivisible Int where+    div = Prelude.div+    mod = Prelude.mod+instance IDivisible Int8 where+    div = Prelude.div+    mod = Prelude.mod+instance IDivisible Int16 where+    div = Prelude.div+    mod = Prelude.mod+instance IDivisible Int32 where+    div = Prelude.div+    mod = Prelude.mod+instance IDivisible Int64 where+    div = Prelude.div+    mod = Prelude.mod+instance IDivisible Natural where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible Word where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible Word8 where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible Word16 where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible Word32 where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible Word64 where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible Word128 where+    div = Word128.quot+    mod = Word128.rem+instance IDivisible Word256 where+    div = Word256.quot+    mod = Word256.rem++instance IDivisible CChar where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CSChar where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CUChar where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CShort where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CUShort where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CInt where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CUInt where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CLong where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CULong where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CPtrdiff where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CSize where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CWchar where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CSigAtomic where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CLLong where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CULLong where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CIntPtr where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CUIntPtr where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CIntMax where+    div = Prelude.quot+    mod = Prelude.rem+instance IDivisible CUIntMax where+    div = Prelude.quot+    mod = Prelude.rem++instance Divisible Prelude.Rational where+    (/) = (Prelude./)+instance Divisible Float where+    (/) = (Prelude./)+instance Divisible Double where+    (/) = (Prelude./)++instance Divisible CFloat where+    (/) = (Prelude./)+instance Divisible CDouble where+    (/) = (Prelude./)++recip :: Divisible a => a -> a+recip x = midentity / x++power :: (Enum n, IsNatural n, IDivisible n, Multiplicative a) => a -> n -> a+power a n+    | n == 0    = midentity+    | otherwise = squaring midentity a n+  where+    squaring y x i+        | i == 0    = y+        | i == 1    = x * y+        | even i    = squaring y (x*x) (i`div`2)+        | otherwise = squaring (x*y) (x*x) (pred i`div` 2)++even :: (IDivisible n, IsIntegral n) => n -> Bool+even n = (n `mod` 2) == 0
+ Basement/Numerical/Number.hs view
@@ -0,0 +1,123 @@+{-# Language CPP #-}+module Basement.Numerical.Number+    ( IsIntegral(..)+    , IsNatural(..)+    ) where++import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Compat.Natural+import           Basement.Compat.NumLiteral+import           Data.Bits+import qualified Prelude++-- | Number literals, convertible through the generic Integer type.+--+-- all number are Enum'erable, meaning that you can move to+-- next element+class (Integral a, Eq a, Ord a) => IsIntegral a where+    {-# MINIMAL toInteger #-}+    toInteger :: a -> Integer++-- | Non Negative Number literals, convertible through the generic Natural type+class IsIntegral a => IsNatural a where+    {-# MINIMAL toNatural #-}+    toNatural :: a -> Natural++instance IsIntegral Integer where+    toInteger i = i+instance IsIntegral Int where+    toInteger i = Prelude.toInteger i+instance IsIntegral Int8 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Int16 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Int32 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Int64 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Natural where+    toInteger i = Prelude.toInteger i+instance IsIntegral Word where+    toInteger i = Prelude.toInteger i+instance IsIntegral Word8 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Word16 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Word32 where+    toInteger i = Prelude.toInteger i+instance IsIntegral Word64 where+    toInteger i = Prelude.toInteger i++instance IsIntegral CChar where+    toInteger i = Prelude.toInteger i+instance IsIntegral CSChar where+    toInteger i = Prelude.toInteger i+instance IsIntegral CUChar where+    toInteger i = Prelude.toInteger i+instance IsIntegral CShort where+    toInteger i = Prelude.toInteger i+instance IsIntegral CUShort where+    toInteger i = Prelude.toInteger i+instance IsIntegral CInt where+    toInteger i = Prelude.toInteger i+instance IsIntegral CUInt where+    toInteger i = Prelude.toInteger i+instance IsIntegral CLong where+    toInteger i = Prelude.toInteger i+instance IsIntegral CULong where+    toInteger i = Prelude.toInteger i+instance IsIntegral CPtrdiff where+    toInteger i = Prelude.toInteger i+instance IsIntegral CSize where+    toInteger i = Prelude.toInteger i+instance IsIntegral CWchar where+    toInteger i = Prelude.toInteger i+instance IsIntegral CSigAtomic where+    toInteger i = Prelude.toInteger i+instance IsIntegral CLLong where+    toInteger i = Prelude.toInteger i+instance IsIntegral CULLong where+    toInteger i = Prelude.toInteger i+#if MIN_VERSION_base(4,10,0)+instance IsIntegral CBool where+    toInteger i = Prelude.toInteger i+#endif+instance IsIntegral CIntPtr where+    toInteger i = Prelude.toInteger i+instance IsIntegral CUIntPtr where+    toInteger i = Prelude.toInteger i+instance IsIntegral CIntMax where+    toInteger i = Prelude.toInteger i+instance IsIntegral CUIntMax where+    toInteger i = Prelude.toInteger i++instance IsNatural Natural where+    toNatural i = i+instance IsNatural Word where+    toNatural i = Prelude.fromIntegral i+instance IsNatural Word8 where+    toNatural i = Prelude.fromIntegral i+instance IsNatural Word16 where+    toNatural i = Prelude.fromIntegral i+instance IsNatural Word32 where+    toNatural i = Prelude.fromIntegral i+instance IsNatural Word64 where+    toNatural i = Prelude.fromIntegral i++instance IsNatural CUChar where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CUShort where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CUInt where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CULong where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CSize where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CULLong where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CUIntPtr where+    toNatural i = Prelude.fromIntegral i+instance IsNatural CUIntMax where+    toNatural i = Prelude.fromIntegral i
+ Basement/Numerical/Subtractive.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE CPP, UndecidableInstances #-}+module Basement.Numerical.Subtractive+    ( Subtractive(..)+    ) where++import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Compat.Natural+import           Basement.IntegralConv+import           Basement.Bounded+import           Basement.Nat+import           Basement.Types.Word128 (Word128)+import           Basement.Types.Word256 (Word256)+import qualified Basement.Types.Word128 as Word128+import qualified Basement.Types.Word256 as Word256+import qualified Prelude++-- | Represent class of things that can be subtracted.+--+--+-- Note that the result is not necessary of the same type+-- as the operand depending on the actual type.+--+-- For example:+--+-- > (-) :: Int -> Int -> Int+-- > (-) :: DateTime -> DateTime -> Seconds+-- > (-) :: Ptr a -> Ptr a -> PtrDiff+-- > (-) :: Natural -> Natural -> Maybe Natural+class Subtractive a where+    type Difference a+    (-) :: a -> a -> Difference a++infixl 6 -++instance Subtractive Integer where+    type Difference Integer = Integer+    (-) = (Prelude.-)+instance Subtractive Int where+    type Difference Int = Int+    (-) = (Prelude.-)+instance Subtractive Int8 where+    type Difference Int8 = Int8+    (-) = (Prelude.-)+instance Subtractive Int16 where+    type Difference Int16 = Int16+    (-) = (Prelude.-)+instance Subtractive Int32 where+    type Difference Int32 = Int32+    (-) = (Prelude.-)+instance Subtractive Int64 where+    type Difference Int64 = Int64+    (-) = (Prelude.-)+instance Subtractive Natural where+    type Difference Natural = Maybe Natural+    (-) a b+        | b > a     = Nothing+        | otherwise = Just (a Prelude.- b)+instance Subtractive Word where+    type Difference Word = Word+    (-) = (Prelude.-)+instance Subtractive Word8 where+    type Difference Word8 = Word8+    (-) = (Prelude.-)+instance Subtractive Word16 where+    type Difference Word16 = Word16+    (-) = (Prelude.-)+instance Subtractive Word32 where+    type Difference Word32 = Word32+    (-) = (Prelude.-)+instance Subtractive Word64 where+    type Difference Word64 = Word64+    (-) = (Prelude.-)+instance Subtractive Word128 where+    type Difference Word128 = Word128+    (-) = (Word128.-)+instance Subtractive Word256 where+    type Difference Word256 = Word256+    (-) = (Word256.-)++instance Subtractive Prelude.Float where+    type Difference Prelude.Float = Prelude.Float+    (-) = (Prelude.-)+instance Subtractive Prelude.Double where+    type Difference Prelude.Double = Prelude.Double+    (-) = (Prelude.-)++instance Subtractive Prelude.Char where+    type Difference Prelude.Char = Prelude.Int+    (-) a b = (Prelude.-) (charToInt a) (charToInt b)+instance (KnownNat n, NatWithinBound Word64 n) => Subtractive (Zn64 n) where+    type Difference (Zn64 n) = Zn64 n+    (-) a b = (Prelude.-) a b+instance KnownNat n => Subtractive (Zn n) where+    type Difference (Zn n) = Zn n+    (-) a b = (Prelude.-) a b++instance Subtractive CChar where+    type Difference CChar = CChar+    (-) = (Prelude.-)+instance Subtractive CSChar where+    type Difference CSChar = CSChar+    (-) = (Prelude.-)+instance Subtractive CUChar where+    type Difference CUChar = CUChar+    (-) = (Prelude.-)+instance Subtractive CShort where+    type Difference CShort = CShort+    (-) = (Prelude.-)+instance Subtractive CUShort where+    type Difference CUShort = CUShort+    (-) = (Prelude.-)+instance Subtractive CInt where+    type Difference CInt = CInt+    (-) = (Prelude.-)+instance Subtractive CUInt where+    type Difference CUInt = CUInt+    (-) = (Prelude.-)+instance Subtractive CLong where+    type Difference CLong = CLong+    (-) = (Prelude.-)+instance Subtractive CULong where+    type Difference CULong = CULong+    (-) = (Prelude.-)+instance Subtractive CPtrdiff where+    type Difference CPtrdiff = CPtrdiff+    (-) = (Prelude.-)+instance Subtractive CSize where+    type Difference CSize = CSize+    (-) = (Prelude.-)+instance Subtractive CWchar where+    type Difference CWchar = CWchar+    (-) = (Prelude.-)+instance Subtractive CSigAtomic where+    type Difference CSigAtomic = CSigAtomic+    (-) = (Prelude.-)+instance Subtractive CLLong where+    type Difference CLLong = CLLong+    (-) = (Prelude.-)+instance Subtractive CULLong where+    type Difference CULLong = CULLong+    (-) = (Prelude.-)+#if MIN_VERSION_base(4,10,0)+instance Subtractive CBool where+    type Difference CBool = CBool+    (-) = (Prelude.-)+#endif+instance Subtractive CIntPtr where+    type Difference CIntPtr = CIntPtr+    (-) = (Prelude.-)+instance Subtractive CUIntPtr where+    type Difference CUIntPtr = CUIntPtr+    (-) = (Prelude.-)+instance Subtractive CIntMax where+    type Difference CIntMax = CIntMax+    (-) = (Prelude.-)+instance Subtractive CUIntMax where+    type Difference CUIntMax = CUIntMax+    (-) = (Prelude.-)+instance Subtractive CClock where+    type Difference CClock = CClock+    (-) = (Prelude.-)+instance Subtractive CTime where+    type Difference CTime = CTime+    (-) = (Prelude.-)+instance Subtractive CUSeconds where+    type Difference CUSeconds = CUSeconds+    (-) = (Prelude.-)+instance Subtractive CSUSeconds where+    type Difference CSUSeconds = CSUSeconds+    (-) = (Prelude.-)+instance Subtractive COff where+    type Difference COff = COff+    (-) = (Prelude.-)++instance Subtractive CFloat where+    type Difference CFloat = CFloat+    (-) = (Prelude.-)+instance Subtractive CDouble where+    type Difference CDouble = CDouble+    (-) = (Prelude.-)
+ Basement/PrimType.hs view
@@ -0,0 +1,763 @@+-- Module      : Basement.PrimType+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+module Basement.PrimType+    ( PrimType(..)+    , PrimMemoryComparable+    , primBaIndex+    , primMbaRead+    , primMbaWrite+    , primArrayIndex+    , primMutableArrayRead+    , primMutableArrayWrite+    , primOffsetOfE+    , primOffsetRecast+    , sizeRecast+    , offsetAsSize+    , sizeAsOffset+    , sizeInBytes+    , offsetInBytes+    , offsetInElements+    , offsetIsAligned+    , primWordGetByteAndShift+    , primWord64GetByteAndShift+    , primWord64GetHiLo+    ) where++#include "MachDeps.h"++import           GHC.Prim+import           GHC.Int+import           GHC.Types+import           GHC.Word+import           Data.Bits+import           Data.Proxy+import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Numerical.Subtractive+import           Basement.Types.OffsetSize+import           Basement.Types.Char7 (Char7(..))+import           Basement.Endianness+import           Basement.Types.Word128 (Word128(..))+import           Basement.Types.Word256 (Word256(..))+import           Basement.Monad+import           Basement.Nat+import qualified Prelude (quot)++#if WORD_SIZE_IN_BITS < 64+import           GHC.IntWord64+#endif++#ifdef FOUNDATION_BOUNDS_CHECK++divBytes :: PrimType ty => Offset ty -> (Int -> Int)+divBytes ofs = \x -> x `Prelude.quot` (getSize Proxy ofs)+  where+    getSize :: PrimType ty => Proxy ty -> Offset ty -> Int+    getSize p _ = let (CountOf sz) = primSizeInBytes p in sz++baLength :: PrimType ty => Offset ty -> ByteArray# -> Int+baLength ofs ba = divBytes ofs (I# (sizeofByteArray# ba))++mbaLength :: PrimType ty => Offset ty -> MutableByteArray# st -> Int+mbaLength ofs ba = divBytes ofs (I# (sizeofMutableByteArray# ba))++aLength :: Array# ty -> Int+aLength ba = I# (sizeofArray# ba)++maLength :: MutableArray# st ty -> Int+maLength ba = I# (sizeofMutableArray# ba)++boundCheckError :: [Char] -> Offset ty -> Int -> a+boundCheckError ty (Offset ofs) len =+    error (ty <> " offset=" <> show ofs <> " len=" <> show len)++baCheck :: PrimType ty => ByteArray# -> Offset ty -> Bool+baCheck ba ofs@(Offset o) = o < 0 || o >= baLength ofs ba++mbaCheck :: PrimType ty => MutableByteArray# st -> Offset ty -> Bool+mbaCheck mba ofs@(Offset o) = o < 0 || o >= mbaLength ofs mba++aCheck :: Array# ty -> Offset ty -> Bool+aCheck ba (Offset o) = o < 0 || o >= aLength ba++maCheck :: MutableArray# st ty -> Offset ty -> Bool+maCheck ma (Offset o) = o < 0 || o >= maLength ma++primBaIndex :: PrimType ty => ByteArray# -> Offset ty -> ty+primBaIndex ba ofs+    | baCheck ba ofs = boundCheckError "bytearray-index" ofs (baLength ofs ba)+    | otherwise      = primBaUIndex ba ofs+{-# NOINLINE primBaIndex #-}++primMbaRead :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> prim ty+primMbaRead mba ofs+    | mbaCheck mba ofs = boundCheckError "mutablebytearray-read" ofs (mbaLength ofs mba)+    | otherwise        = primMbaURead mba ofs+{-# NOINLINE primMbaRead #-}++primMbaWrite :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()+primMbaWrite mba ofs ty+    | mbaCheck mba ofs = boundCheckError "mutablebytearray-write" ofs (mbaLength ofs mba)+    | otherwise        = primMbaUWrite mba ofs ty+{-# NOINLINE primMbaWrite #-}++primArrayIndex :: Array# ty -> Offset ty -> ty+primArrayIndex a o@(Offset (I# ofs))+    | aCheck a o = boundCheckError "array-index" o (aLength a)+    | otherwise  = let !(# v #) = indexArray# a ofs in v+{-# NOINLINE primArrayIndex #-}++primMutableArrayRead :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> prim ty+primMutableArrayRead ma o@(Offset (I# ofs))+    | maCheck ma o = boundCheckError "array-read" o (maLength ma)+    | otherwise    = primitive $ \s1 -> readArray# ma ofs s1+{-# NOINLINE primMutableArrayRead #-}++primMutableArrayWrite :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> ty -> prim ()+primMutableArrayWrite ma o@(Offset (I# ofs)) v+    | maCheck ma o = boundCheckError "array-write" o (maLength ma)+    | otherwise    = primitive $ \s1 -> let !s2 = writeArray# ma ofs v s1 in (# s2, () #)+{-# NOINLINE primMutableArrayWrite #-}++#else++primBaIndex :: PrimType ty => ByteArray# -> Offset ty -> ty+primBaIndex = primBaUIndex+{-# INLINE primBaIndex #-}++primMbaRead :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> prim ty+primMbaRead = primMbaURead+{-# INLINE primMbaRead #-}++primMbaWrite :: (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()+primMbaWrite = primMbaUWrite+{-# INLINE primMbaWrite #-}++primArrayIndex :: Array# ty -> Offset ty -> ty+primArrayIndex a (Offset (I# ofs)) = let !(# v #) = indexArray# a ofs in v+{-# INLINE primArrayIndex #-}++primMutableArrayRead :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> prim ty+primMutableArrayRead ma (Offset (I# ofs)) = primitive $ \s1 -> readArray# ma ofs s1+{-# INLINE primMutableArrayRead #-}++primMutableArrayWrite :: PrimMonad prim => MutableArray# (PrimState prim) ty -> Offset ty -> ty -> prim ()+primMutableArrayWrite ma (Offset (I# ofs)) v =+    primitive $ \s1 -> let !s2 = writeArray# ma ofs v s1 in (# s2, () #)+{-# INLINE primMutableArrayWrite #-}++#endif++-- | Represent the accessor for types that can be stored in the UArray and MUArray.+--+-- Types need to be a instance of storable and have fixed sized.+class Eq ty => PrimType ty where+    -- | type level size of the given `ty`+    type PrimSize ty :: Nat++    -- | get the size in bytes of a ty element+    primSizeInBytes :: Proxy ty -> CountOf Word8++    -- | get the shift size+    primShiftToBytes :: Proxy ty -> Int++    -----+    -- ByteArray section+    -----++    -- | return the element stored at a specific index+    primBaUIndex :: ByteArray# -> Offset ty -> ty++    -----+    -- MutableByteArray section+    -----++    -- | Read an element at an index in a mutable array+    primMbaURead :: PrimMonad prim+                => MutableByteArray# (PrimState prim) -- ^ mutable array to read from+                -> Offset ty                         -- ^ index of the element to retrieve+                -> prim ty                           -- ^ the element returned++    -- | Write an element to a specific cell in a mutable array.+    primMbaUWrite :: PrimMonad prim+                 => MutableByteArray# (PrimState prim) -- ^ mutable array to modify+                 -> Offset ty                         -- ^ index of the element to modify+                 -> ty                                 -- ^ the new value to store+                 -> prim ()++    -----+    -- Addr# section+    -----++    -- | Read from Address, without a state. the value read should be considered a constant for all+    -- pratical purpose, otherwise bad thing will happens.+    primAddrIndex :: Addr# -> Offset ty -> ty++    -- | Read a value from Addr in a specific primitive monad+    primAddrRead :: PrimMonad prim+                 => Addr#+                 -> Offset ty+                 -> prim ty+    -- | Write a value to Addr in a specific primitive monad+    primAddrWrite :: PrimMonad prim+                  => Addr#+                  -> Offset ty+                  -> ty+                  -> prim ()++sizeInt, sizeWord :: CountOf Word8+shiftInt, shiftWord :: Int+#if WORD_SIZE_IN_BITS == 64+sizeInt = CountOf 8+sizeWord = CountOf 8+shiftInt = 3+shiftWord = 3+#else+sizeInt = CountOf 4+sizeWord = CountOf 4+shiftInt = 2+shiftWord = 2+#endif++{-# SPECIALIZE [3] primBaUIndex :: ByteArray# -> Offset Word8 -> Word8 #-}++instance PrimType Int where+#if WORD_SIZE_IN_BITS == 64+    type PrimSize Int = 8+#else+    type PrimSize Int = 4+#endif+    primSizeInBytes _ = sizeInt+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = shiftInt+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = I# (indexIntArray# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readIntArray# mba n s1 in (# s2, I# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (I# w) = primitive $ \s1 -> (# writeIntArray# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = I# (indexIntOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readIntOffAddr# addr n s1 in (# s2, I# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I# w) = primitive $ \s1 -> (# writeIntOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Word where+#if WORD_SIZE_IN_BITS == 64+    type PrimSize Word = 8+#else+    type PrimSize Word = 4+#endif+    primSizeInBytes _ = sizeWord+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = shiftWord+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = W# (indexWordArray# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWordArray# mba n s1 in (# s2, W# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (W# w) = primitive $ \s1 -> (# writeWordArray# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = W# (indexWordOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWordOffAddr# addr n s1 in (# s2, W# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W# w) = primitive $ \s1 -> (# writeWordOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Word8 where+    type PrimSize Word8 = 1+    primSizeInBytes _ = CountOf 1+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 0+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = W8# (indexWord8Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord8Array# mba n s1 in (# s2, W8# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (W8# w) = primitive $ \s1 -> (# writeWord8Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = W8# (indexWord8OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord8OffAddr# addr n s1 in (# s2, W8# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W8# w) = primitive $ \s1 -> (# writeWord8OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Word16 where+    type PrimSize Word16 = 2+    primSizeInBytes _ = CountOf 2+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 1+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = W16# (indexWord16Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord16Array# mba n s1 in (# s2, W16# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (W16# w) = primitive $ \s1 -> (# writeWord16Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = W16# (indexWord16OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord16OffAddr# addr n s1 in (# s2, W16# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W16# w) = primitive $ \s1 -> (# writeWord16OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Word32 where+    type PrimSize Word32 = 4+    primSizeInBytes _ = CountOf 4+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 2+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = W32# (indexWord32Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord32Array# mba n s1 in (# s2, W32# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (W32# w) = primitive $ \s1 -> (# writeWord32Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = W32# (indexWord32OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord32OffAddr# addr n s1 in (# s2, W32# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W32# w) = primitive $ \s1 -> (# writeWord32OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Word64 where+    type PrimSize Word64 = 8+    primSizeInBytes _ = CountOf 8+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 3+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = W64# (indexWord64Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord64Array# mba n s1 in (# s2, W64# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (W64# w) = primitive $ \s1 -> (# writeWord64Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = W64# (indexWord64OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWord64OffAddr# addr n s1 in (# s2, W64# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W64# w) = primitive $ \s1 -> (# writeWord64OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Word128 where+    type PrimSize Word128 = 16+    primSizeInBytes _ = CountOf 16+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 4+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba n =+        Word128 (W64# (indexWord64Array# ba n1)) (W64# (indexWord64Array# ba n2))+      where (# n1, n2 #) = offset128_64 n+    {-# INLINE primBaUIndex #-}+    primMbaURead mba n = primitive $ \s1 -> let !(# s2, r1 #) = readWord64Array# mba n1 s1+                                                !(# s3, r2 #) = readWord64Array# mba n2 s2+                                             in (# s3, Word128 (W64# r1) (W64# r2) #)+      where (# n1, n2 #) = offset128_64 n+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba n (Word128 (W64# w1) (W64# w2)) = primitive $ \s1 ->+        let !s2 = writeWord64Array# mba n1 w1 s1+         in (# writeWord64Array# mba n2 w2 s2, () #)+      where (# n1, n2 #) = offset128_64 n+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr n = Word128 (W64# (indexWord64OffAddr# addr n1)) (W64# (indexWord64OffAddr# addr n2))+      where (# n1, n2 #) = offset128_64 n+    {-# INLINE primAddrIndex #-}+    primAddrRead addr n = primitive $ \s1 -> let !(# s2, r1 #) = readWord64OffAddr# addr n1 s1+                                                 !(# s3, r2 #) = readWord64OffAddr# addr n2 s2+                                              in (# s3, Word128 (W64# r1) (W64# r2) #)+      where (# n1, n2 #) = offset128_64 n+    {-# INLINE primAddrRead #-}+    primAddrWrite addr n (Word128 (W64# w1) (W64# w2)) = primitive $ \s1 ->+        let !s2 = writeWord64OffAddr# addr n1 w1 s1+         in (# writeWord64OffAddr# addr n2 w2 s2, () #)+      where (# n1, n2 #) = offset128_64 n+    {-# INLINE primAddrWrite #-}+instance PrimType Word256 where+    type PrimSize Word256 = 32+    primSizeInBytes _ = CountOf 32+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 5+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba n =+        Word256 (W64# (indexWord64Array# ba n1)) (W64# (indexWord64Array# ba n2))+                (W64# (indexWord64Array# ba n3)) (W64# (indexWord64Array# ba n4))+      where (# n1, n2, n3, n4 #) = offset256_64 n+    {-# INLINE primBaUIndex #-}+    primMbaURead mba n = primitive $ \s1 -> let !(# s2, r1 #) = readWord64Array# mba n1 s1+                                                !(# s3, r2 #) = readWord64Array# mba n2 s2+                                                !(# s4, r3 #) = readWord64Array# mba n3 s3+                                                !(# s5, r4 #) = readWord64Array# mba n4 s4+                                             in (# s5, Word256 (W64# r1) (W64# r2) (W64# r3) (W64# r4) #)+      where (# n1, n2, n3, n4 #) = offset256_64 n+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba n (Word256 (W64# w1) (W64# w2) (W64# w3) (W64# w4)) = primitive $ \s1 ->+        let !s2 = writeWord64Array# mba n1 w1 s1+            !s3 = writeWord64Array# mba n2 w2 s2+            !s4 = writeWord64Array# mba n3 w3 s3+         in (# writeWord64Array# mba n4 w4 s4, () #)+      where (# n1, n2, n3, n4 #) = offset256_64 n+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr n = Word256 (W64# (indexWord64OffAddr# addr n1)) (W64# (indexWord64OffAddr# addr n2))+                                   (W64# (indexWord64OffAddr# addr n3)) (W64# (indexWord64OffAddr# addr n4))+      where (# n1, n2, n3, n4 #) = offset256_64 n+    {-# INLINE primAddrIndex #-}+    primAddrRead addr n = primitive $ \s1 -> let !(# s2, r1 #) = readWord64OffAddr# addr n1 s1+                                                 !(# s3, r2 #) = readWord64OffAddr# addr n2 s2+                                                 !(# s4, r3 #) = readWord64OffAddr# addr n3 s3+                                                 !(# s5, r4 #) = readWord64OffAddr# addr n4 s4+                                              in (# s5, Word256 (W64# r1) (W64# r2) (W64# r3) (W64# r4) #)+      where (# n1, n2, n3, n4 #) = offset256_64 n+    {-# INLINE primAddrRead #-}+    primAddrWrite addr n (Word256 (W64# w1) (W64# w2) (W64# w3) (W64# w4)) = primitive $ \s1 ->+        let !s2 = writeWord64OffAddr# addr n1 w1 s1+            !s3 = writeWord64OffAddr# addr n2 w2 s2+            !s4 = writeWord64OffAddr# addr n3 w3 s3+         in (# writeWord64OffAddr# addr n4 w4 s4, () #)+      where (# n1, n2, n3, n4 #) = offset256_64 n+    {-# INLINE primAddrWrite #-}+instance PrimType Int8 where+    type PrimSize Int8 = 1+    primSizeInBytes _ = CountOf 1+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 0+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = I8# (indexInt8Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt8Array# mba n s1 in (# s2, I8# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (I8# w) = primitive $ \s1 -> (# writeInt8Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = I8# (indexInt8OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt8OffAddr# addr n s1 in (# s2, I8# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I8# w) = primitive $ \s1 -> (# writeInt8OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int16 where+    type PrimSize Int16 = 2+    primSizeInBytes _ = CountOf 2+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 1+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = I16# (indexInt16Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt16Array# mba n s1 in (# s2, I16# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (I16# w) = primitive $ \s1 -> (# writeInt16Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = I16# (indexInt16OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt16OffAddr# addr n s1 in (# s2, I16# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I16# w) = primitive $ \s1 -> (# writeInt16OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int32 where+    type PrimSize Int32 = 4+    primSizeInBytes _ = CountOf 4+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 2+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = I32# (indexInt32Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt32Array# mba n s1 in (# s2, I32# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (I32# w) = primitive $ \s1 -> (# writeInt32Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = I32# (indexInt32OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt32OffAddr# addr n s1 in (# s2, I32# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I32# w) = primitive $ \s1 -> (# writeInt32OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int64 where+    type PrimSize Int64 = 8+    primSizeInBytes _ = CountOf 8+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 3+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = I64# (indexInt64Array# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt64Array# mba n s1 in (# s2, I64# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (I64# w) = primitive $ \s1 -> (# writeInt64Array# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = I64# (indexInt64OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readInt64OffAddr# addr n s1 in (# s2, I64# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I64# w) = primitive $ \s1 -> (# writeInt64OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Float where+    type PrimSize Float = 4+    primSizeInBytes _ = CountOf 4+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 2+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = F# (indexFloatArray# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readFloatArray# mba n s1 in (# s2, F# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (F# w) = primitive $ \s1 -> (# writeFloatArray# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = F# (indexFloatOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readFloatOffAddr# addr n s1 in (# s2, F# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (F# w) = primitive $ \s1 -> (# writeFloatOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Double where+    type PrimSize Double = 8+    primSizeInBytes _ = CountOf 8+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 3+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = D# (indexDoubleArray# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readDoubleArray# mba n s1 in (# s2, D# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (D# w) = primitive $ \s1 -> (# writeDoubleArray# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = D# (indexDoubleOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readDoubleOffAddr# addr n s1 in (# s2, D# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (D# w) = primitive $ \s1 -> (# writeDoubleOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Char where+    type PrimSize Char = 4+    primSizeInBytes _ = CountOf 4+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 2+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset (I# n)) = C# (indexWideCharArray# ba n)+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWideCharArray# mba n s1 in (# s2, C# r #)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset (I# n)) (C# w) = primitive $ \s1 -> (# writeWideCharArray# mba n w s1, () #)+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset (I# n)) = C# (indexWideCharOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let !(# s2, r #) = readWideCharOffAddr# addr n s1 in (# s2, C# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (C# w) = primitive $ \s1 -> (# writeWideCharOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType CChar where+    type PrimSize CChar = 1+    primSizeInBytes _ = CountOf 1+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 0+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset n) = CChar (primBaUIndex ba (Offset n))+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset n) = CChar <$> primMbaURead mba (Offset n)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset n) (CChar int8) = primMbaUWrite mba (Offset n) int8+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset n) = CChar $ primAddrIndex addr (Offset n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset n) = CChar <$> primAddrRead addr (Offset n)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset n) (CChar int8) = primAddrWrite addr (Offset n) int8+    {-# INLINE primAddrWrite #-}+instance PrimType CUChar where+    type PrimSize CUChar = 1+    primSizeInBytes _ = CountOf 1+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 0+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset n) = CUChar (primBaUIndex ba (Offset n :: Offset Word8))+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset n) = CUChar <$> primMbaURead mba (Offset n :: Offset Word8)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset n) (CUChar w8) = primMbaUWrite mba (Offset n) w8+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset n) = CUChar $ primAddrIndex addr (Offset n :: Offset Word8)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset n) = CUChar <$> primAddrRead addr (Offset n :: Offset Word8)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset n) (CUChar w8) = primAddrWrite addr (Offset n) w8+    {-# INLINE primAddrWrite #-}++instance PrimType Char7 where+    type PrimSize Char7 = 1+    primSizeInBytes _ = CountOf 1+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = 0+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset n) = Char7 (primBaUIndex ba (Offset n :: Offset Word8))+    {-# INLINE primBaUIndex #-}+    primMbaURead mba (Offset n) = Char7 <$> primMbaURead mba (Offset n :: Offset Word8)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset n) (Char7 w8) = primMbaUWrite mba (Offset n) w8+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset n) = Char7 $ primAddrIndex addr (Offset n :: Offset Word8)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset n) = Char7 <$> primAddrRead addr (Offset n :: Offset Word8)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset n) (Char7 w8) = primAddrWrite addr (Offset n) w8+    {-# INLINE primAddrWrite #-}++instance PrimType a => PrimType (LE a) where+    type PrimSize (LE a) = PrimSize a+    primSizeInBytes _ = primSizeInBytes (Proxy :: Proxy a)+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = primShiftToBytes (Proxy :: Proxy a)+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset a) = LE $ primBaUIndex ba (Offset a)+    {-# INLINE primBaUIndex #-}+    primMbaURead ba (Offset a) = LE <$> primMbaURead ba (Offset a)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset a) (LE w) = primMbaUWrite mba (Offset a) w+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset a) = LE $ primAddrIndex addr (Offset a)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset a) = LE <$> primAddrRead addr (Offset a)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset a) (LE w) = primAddrWrite addr (Offset a) w+    {-# INLINE primAddrWrite #-}+instance PrimType a => PrimType (BE a) where+    type PrimSize (BE a) = PrimSize a+    primSizeInBytes _ = primSizeInBytes (Proxy :: Proxy a)+    {-# INLINE primSizeInBytes #-}+    primShiftToBytes _ = primShiftToBytes (Proxy :: Proxy a)+    {-# INLINE primShiftToBytes #-}+    primBaUIndex ba (Offset a) = BE $ primBaUIndex ba (Offset a)+    {-# INLINE primBaUIndex #-}+    primMbaURead ba (Offset a) = BE <$> primMbaURead ba (Offset a)+    {-# INLINE primMbaURead #-}+    primMbaUWrite mba (Offset a) (BE w) = primMbaUWrite mba (Offset a) w+    {-# INLINE primMbaUWrite #-}+    primAddrIndex addr (Offset a) = BE $ primAddrIndex addr (Offset a)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset a) = BE <$> primAddrRead addr (Offset a)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset a) (BE w) = primAddrWrite addr (Offset a) w+    {-# INLINE primAddrWrite #-}++-- | A constraint class for serializable type that have an unique+-- memory compare representation+--+-- e.g. Float and Double have -0.0 and 0.0 which are Eq individual,+-- yet have a different memory representation which doesn't allow+-- for memcmp operation+class PrimMemoryComparable ty where++instance PrimMemoryComparable Int where+instance PrimMemoryComparable Word where+instance PrimMemoryComparable Word8 where+instance PrimMemoryComparable Word16 where+instance PrimMemoryComparable Word32 where+instance PrimMemoryComparable Word64 where+instance PrimMemoryComparable Word128 where+instance PrimMemoryComparable Word256 where+instance PrimMemoryComparable Int8 where+instance PrimMemoryComparable Int16 where+instance PrimMemoryComparable Int32 where+instance PrimMemoryComparable Int64 where+instance PrimMemoryComparable Char where+instance PrimMemoryComparable CChar where+instance PrimMemoryComparable CUChar where+instance PrimMemoryComparable a => PrimMemoryComparable (LE a) where+instance PrimMemoryComparable a => PrimMemoryComparable (BE a) where++offset128_64 :: Offset Word128 -> (# Int#, Int# #)+offset128_64 (Offset (I# i)) = (# n , n +# 1# #)+  where !n = uncheckedIShiftL# i 1#++offset256_64 :: Offset Word256 -> (# Int#, Int#, Int#, Int# #)+offset256_64 (Offset (I# i)) = (# n , n +# 1#, n +# 2#, n +# 3# #)+  where !n = uncheckedIShiftL# i 2#++-- | Cast a CountOf linked to type A (CountOf A) to a CountOf linked to type B (CountOf B)+sizeRecast :: forall a b . (PrimType a, PrimType b) => CountOf a -> CountOf b+sizeRecast sz = CountOf (bytes `Prelude.quot` szB)+  where !szA             = primSizeInBytes (Proxy :: Proxy a)+        !(CountOf szB)   = primSizeInBytes (Proxy :: Proxy b)+        !(CountOf bytes) = sizeOfE szA sz+{-# INLINE [1] sizeRecast #-}+{-# RULES "sizeRecast from Word8" [2] forall a . sizeRecast a = sizeRecastBytes a #-}++sizeRecastBytes :: forall b . PrimType b => CountOf Word8 -> CountOf b+sizeRecastBytes (CountOf w) = CountOf (w `Prelude.quot` szB)+  where !(CountOf szB) = primSizeInBytes (Proxy :: Proxy b)+{-# INLINE [1] sizeRecastBytes #-}++sizeInBytes :: forall a . PrimType a => CountOf a -> CountOf Word8+sizeInBytes sz = sizeOfE (primSizeInBytes (Proxy :: Proxy a)) sz++offsetInBytes :: forall a . PrimType a => Offset a -> Offset Word8+offsetInBytes ofs = offsetShiftL (primShiftToBytes (Proxy :: Proxy a)) ofs+{-# INLINE [2] offsetInBytes #-}+{-# SPECIALIZE INLINE [3] offsetInBytes :: Offset Word64 -> Offset Word8 #-}+{-# SPECIALIZE INLINE [3] offsetInBytes :: Offset Word32 -> Offset Word8 #-}+{-# SPECIALIZE INLINE [3] offsetInBytes :: Offset Word16 -> Offset Word8 #-}+{-# RULES "offsetInBytes Bytes" [3] forall x . offsetInBytes x = x #-}++offsetInElements :: forall a . PrimType a => Offset Word8 -> Offset a+offsetInElements ofs = offsetShiftR (primShiftToBytes (Proxy :: Proxy a)) ofs+{-# INLINE [2] offsetInElements #-}+{-# SPECIALIZE INLINE [3] offsetInBytes :: Offset Word64 -> Offset Word8 #-}+{-# SPECIALIZE INLINE [3] offsetInBytes :: Offset Word32 -> Offset Word8 #-}+{-# SPECIALIZE INLINE [3] offsetInBytes :: Offset Word16 -> Offset Word8 #-}+{-# RULES "offsetInElements Bytes" [3] forall x . offsetInElements x = x #-}++primOffsetRecast :: forall a b . (PrimType a, PrimType b) => Offset a -> Offset b+primOffsetRecast !ofs =+    let !(Offset bytes) = offsetOfE szA ofs+     in Offset (bytes `Prelude.quot` szB)+  where+    !szA        = primSizeInBytes (Proxy :: Proxy a)+    !(CountOf szB) = primSizeInBytes (Proxy :: Proxy b)+{-# INLINE [1] primOffsetRecast #-}+{-# RULES "primOffsetRecast W8" [3] forall a . primOffsetRecast a = primOffsetRecastBytes a #-}++offsetIsAligned :: forall a . PrimType a => Proxy a -> Offset Word8 -> Bool+offsetIsAligned _ (Offset ofs) = (ofs .&. mask) == 0+   where (CountOf sz) = primSizeInBytes (Proxy :: Proxy a)+         mask = sz - 1+{-# INLINE [1] offsetIsAligned #-}+{-# SPECIALIZE [3] offsetIsAligned :: Proxy Word64 -> Offset Word8 -> Bool #-}+{-# RULES "offsetInAligned Bytes" [3] forall (prx :: Proxy Word8) x . offsetIsAligned prx x = True #-}++primOffsetRecastBytes :: forall b . PrimType b => Offset Word8 -> Offset b+primOffsetRecastBytes (Offset 0) = Offset 0+primOffsetRecastBytes (Offset o) = Offset (szA `Prelude.quot` o)+  where !(CountOf szA) = primSizeInBytes (Proxy :: Proxy b)+{-# INLINE [1] primOffsetRecastBytes #-}++primOffsetOfE :: forall a . PrimType a => Offset a -> Offset Word8+primOffsetOfE = offsetInBytes+{-# DEPRECATED primOffsetOfE "use offsetInBytes" #-}++primWordGetByteAndShift :: Word# -> (# Word#, Word# #)+primWordGetByteAndShift w = (# and# w 0xff##, uncheckedShiftRL# w 8# #)+{-# INLINE primWordGetByteAndShift #-}++#if WORD_SIZE_IN_BITS == 64+primWord64GetByteAndShift :: Word# -> (# Word#, Word# #)+primWord64GetByteAndShift = primWord64GetByteAndShift++primWord64GetHiLo :: Word# -> (# Word#, Word# #)+primWord64GetHiLo w = (# uncheckedShiftRL# w 32# , and# w 0xffffffff## #)+#else+primWord64GetByteAndShift :: Word64# -> (# Word#, Word64# #)+primWord64GetByteAndShift w = (# and# (word64ToWord# w) 0xff##, uncheckedShiftRL64# w 8# #)++primWord64GetHiLo :: Word64# -> (# Word#, Word# #)+primWord64GetHiLo w = (# word64ToWord# (uncheckedShiftRL64# w 32#), word64ToWord# w #)+#endif+{-# INLINE primWord64GetByteAndShift #-}
+ Basement/Runtime.hs view
@@ -0,0 +1,31 @@+-- |+-- Module      : Basement.Runtime+-- License     : BSD-style+-- Maintainer  : foundation+--+-- Global configuration environment+module Basement.Runtime+    where++import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           System.Environment+import           System.IO.Unsafe (unsafePerformIO)+import           Text.Read        (readMaybe)++-- | Defines the maximum size in bytes of unpinned arrays.+--+-- You can change this value by setting the environment variable+-- @HS_FOUNDATION_UARRAY_UNPINNED_MAX@ to an unsigned integer number.+--+-- Note: We use 'unsafePerformIO' here. If the environment variable+-- changes during runtime and the runtime system decides to recompute+-- this value, referential transparency is violated (like the First+-- Order violated the Galactic Concordance!).+--+-- TODO The default value of 1024 bytes is arbitrarily chosen for now.+unsafeUArrayUnpinnedMaxSize :: CountOf Word8+unsafeUArrayUnpinnedMaxSize = unsafePerformIO $ do+    maxSize <- (>>= readMaybe) <$> lookupEnv "HS_FOUNDATION_UARRAY_UNPINNED_MAX"+    pure $ maybe (CountOf 1024) CountOf maxSize+{-# NOINLINE unsafeUArrayUnpinnedMaxSize #-}
+ Basement/Show.hs view
@@ -0,0 +1,14 @@+module Basement.Show+    where++import qualified Prelude+import           Basement.Compat.Base+import           Basement.UTF8.Base (String)++-- | Use the Show class to create a String.+--+-- Note that this is not efficient, since+-- an intermediate [Char] is going to be+-- created before turning into a real String.+show :: Prelude.Show a => a -> String+show = fromList . Prelude.show
+ Basement/Sized/Block.hs view
@@ -0,0 +1,278 @@+-- |+-- Module      : Basement.Sized.Block+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+--+-- A Nat-sized version of Block+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeOperators              #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE NoStarIsType               #-}+#endif++module Basement.Sized.Block+    ( BlockN+    , MutableBlockN+    , length+    , lengthBytes+    , toBlockN+    , toBlock+    , new+    , newPinned+    , singleton+    , replicate+    , thaw+    , freeze+    , index+    , indexStatic+    , map+    , foldl'+    , foldr+    , cons+    , snoc+    , elem+    , sub+    , uncons+    , unsnoc+    , splitAt+    , all+    , any+    , find+    , reverse+    , sortBy+    , intersperse+    , withPtr+    , withMutablePtr+    , withMutablePtrHint+    , cast+    , mutableCast+    ) where++import           Data.Proxy (Proxy(..))+import           Basement.Compat.Base+import           Basement.Numerical.Additive (scale)+import           Basement.Block (Block, MutableBlock(..), unsafeIndex)+import qualified Basement.Block as B+import qualified Basement.Block.Base as B+import           Basement.Monad (PrimMonad, PrimState)+import           Basement.Nat+import           Basement.Types.OffsetSize+import           Basement.NormalForm+import           Basement.PrimType (PrimType, PrimSize, primSizeInBytes)++-- | Sized version of 'Block'+--+newtype BlockN (n :: Nat) a = BlockN { unBlock :: Block a }+  deriving (NormalForm, Eq, Show, Data, Ord)++newtype MutableBlockN (n :: Nat) ty st = MutableBlockN { unMBlock :: MutableBlock ty st }++toBlockN :: forall n ty . (PrimType ty, KnownNat n, Countable ty n) => Block ty -> Maybe (BlockN n ty)+toBlockN b+    | expected == B.length b = Just (BlockN b)+    | otherwise = Nothing+  where+    expected = toCount @n++length :: forall n ty+        . (KnownNat n, Countable ty n)+       => BlockN n ty+       -> CountOf ty+length _ = toCount @n++lengthBytes :: forall n ty+             . PrimType ty+            => BlockN n ty+            -> CountOf Word8+lengthBytes = B.lengthBytes . unBlock++toBlock :: BlockN n ty -> Block ty+toBlock = unBlock++cast :: forall n m a b+      . ( PrimType a, PrimType b+        , KnownNat n, KnownNat m+        , ((PrimSize b) * m) ~ ((PrimSize a) * n)+        )+      => BlockN n a+      -> BlockN m b+cast (BlockN b) = BlockN (B.unsafeCast b)++mutableCast :: forall n m a b st+             . ( PrimType a, PrimType b+             , KnownNat n, KnownNat m+             , ((PrimSize b) * m) ~ ((PrimSize a) * n)+             )+            => MutableBlockN n a st+            -> MutableBlockN m b st+mutableCast (MutableBlockN b) = MutableBlockN (B.unsafeRecast b)++-- | Create a new unpinned mutable block of a specific N size of 'ty' elements+--+-- If the size exceeds a GHC-defined threshold, then the memory will be+-- pinned. To be certain about pinning status with small size, use 'newPinned'+new :: forall n ty prim+     . (PrimType ty, KnownNat n, Countable ty n, PrimMonad prim)+    => prim (MutableBlockN n ty (PrimState prim))+new = MutableBlockN <$> B.new (toCount @n)++-- | Create a new pinned mutable block of a specific N size of 'ty' elements+newPinned :: forall n ty prim+           . (PrimType ty, KnownNat n, Countable ty n, PrimMonad prim)+          => prim (MutableBlockN n ty (PrimState prim))+newPinned = MutableBlockN <$> B.newPinned (toCount @n)++singleton :: PrimType ty => ty -> BlockN 1 ty+singleton a = BlockN (B.singleton a)++replicate :: forall n ty . (KnownNat n, Countable ty n, PrimType ty) => ty -> BlockN n ty+replicate a = BlockN (B.replicate (toCount @n) a)++thaw :: (KnownNat n, PrimMonad prim, PrimType ty) => BlockN n ty -> prim (MutableBlockN n ty (PrimState prim))+thaw b = MutableBlockN <$> B.thaw (unBlock b)++freeze ::  (PrimMonad prim, PrimType ty, Countable ty n) => MutableBlockN n ty (PrimState prim) -> prim (BlockN n ty)+freeze b = BlockN <$> B.freeze (unMBlock b)++indexStatic :: forall i n ty . (KnownNat i, CmpNat i n ~ 'LT, PrimType ty, Offsetable ty i) => BlockN n ty -> ty+indexStatic b = unsafeIndex (unBlock b) (toOffset @i)++index :: forall i n ty . PrimType ty => BlockN n ty -> Offset ty -> ty+index b ofs = B.index (unBlock b) ofs++map :: (PrimType a, PrimType b) => (a -> b) -> BlockN n a -> BlockN n b+map f b = BlockN (B.map f (unBlock b))++foldl' :: PrimType ty => (a -> ty -> a) -> a -> BlockN n ty -> a+foldl' f acc b = B.foldl' f acc (unBlock b)++foldr :: PrimType ty => (ty -> a -> a) -> a -> BlockN n ty -> a+foldr f acc b = B.foldr f acc (unBlock b)++cons :: PrimType ty => ty -> BlockN n ty -> BlockN (n+1) ty+cons e = BlockN . B.cons e . unBlock++snoc :: PrimType ty => BlockN n ty -> ty -> BlockN (n+1) ty+snoc b = BlockN . B.snoc (unBlock b)++sub :: forall i j n ty+     . ( (i <=? n) ~ 'True+       , (j <=? n) ~ 'True+       , (i <=? j) ~ 'True+       , PrimType ty+       , KnownNat i+       , KnownNat j+       , Offsetable ty i+       , Offsetable ty j )+    => BlockN n ty+    -> BlockN (j-i) ty+sub block = BlockN (B.sub (unBlock block) (toOffset @i) (toOffset @j))++uncons :: forall n ty . (CmpNat 0 n ~ 'LT, PrimType ty, KnownNat n, Offsetable ty n)+       => BlockN n ty+       -> (ty, BlockN (n-1) ty)+uncons b = (indexStatic @0 b, BlockN (B.sub (unBlock b) 1 (toOffset @n)))++unsnoc :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, PrimType ty, Offsetable ty n)+       => BlockN n ty+       -> (BlockN (n-1) ty, ty)+unsnoc b =+    ( BlockN (B.sub (unBlock b) 0 (toOffset @n `offsetSub` 1))+    , unsafeIndex (unBlock b) (toOffset @n `offsetSub` 1))++splitAt :: forall i n ty . (CmpNat i n ~ 'LT, PrimType ty, KnownNat i, Countable ty i) => BlockN n ty -> (BlockN i ty, BlockN (n-i) ty)+splitAt b =+    let (left, right) = B.splitAt (toCount @i) (unBlock b)+     in (BlockN left, BlockN right)++elem :: PrimType ty => ty -> BlockN n ty -> Bool+elem e b = B.elem e (unBlock b)++all :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool+all p b = B.all p (unBlock b)++any :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Bool+any p b = B.any p (unBlock b)++find :: PrimType ty => (ty -> Bool) -> BlockN n ty -> Maybe ty+find p b = B.find p (unBlock b)++reverse :: PrimType ty => BlockN n ty -> BlockN n ty+reverse = BlockN . B.reverse . unBlock++sortBy :: PrimType ty => (ty -> ty -> Ordering) -> BlockN n ty -> BlockN n ty+sortBy f b = BlockN (B.sortBy f (unBlock b))++intersperse :: (CmpNat n 1 ~ 'GT, PrimType ty) => ty -> BlockN n ty -> BlockN (n+n-1) ty+intersperse sep b = BlockN (B.intersperse sep (unBlock b))++toCount :: forall n ty . (KnownNat n, Countable ty n) => CountOf ty+toCount = natValCountOf (Proxy @n)++toOffset :: forall n ty . (KnownNat n, Offsetable ty n) => Offset ty+toOffset = natValOffset (Proxy @n)++-- | Get a Ptr pointing to the data in the Block.+--+-- Since a Block is immutable, this Ptr shouldn't be+-- to use to modify the contents+--+-- If the Block is pinned, then its address is returned as is,+-- however if it's unpinned, a pinned copy of the Block is made+-- before getting the address.+withPtr :: (PrimMonad prim, KnownNat n)+        => BlockN n ty+        -> (Ptr ty -> prim a)+        -> prim a+withPtr b = B.withPtr (unBlock b)++-- | Create a pointer on the beginning of the MutableBlock+-- and call a function 'f'.+--+-- The mutable block can be mutated by the 'f' function+-- and the change will be reflected in the mutable block+--+-- If the mutable block is unpinned, a trampoline buffer+-- is created and the data is only copied when 'f' return.+--+-- it is all-in-all highly inefficient as this cause 2 copies+withMutablePtr :: (PrimMonad prim, KnownNat n)+               => MutableBlockN n ty (PrimState prim)+               -> (Ptr ty -> prim a)+               -> prim a+withMutablePtr mb = B.withMutablePtr (unMBlock mb)++-- | Same as 'withMutablePtr' but allow to specify 2 optimisations+-- which is only useful when the MutableBlock is unpinned and need+-- a pinned trampoline to be called safely.+--+-- If skipCopy is True, then the first copy which happen before+-- the call to 'f', is skipped. The Ptr is now effectively+-- pointing to uninitialized data in a new mutable Block.+--+-- If skipCopyBack is True, then the second copy which happen after+-- the call to 'f', is skipped. Then effectively in the case of a+-- trampoline being used the memory changed by 'f' will not+-- be reflected in the original Mutable Block.+--+-- If using the wrong parameters, it will lead to difficult to+-- debug issue of corrupted buffer which only present themselves+-- with certain Mutable Block that happened to have been allocated+-- unpinned.+--+-- If unsure use 'withMutablePtr', which default to *not* skip+-- any copy.+withMutablePtrHint :: forall n ty prim a . (PrimMonad prim, KnownNat n)+                   => Bool -- ^ hint that the buffer doesn't need to have the same value as the mutable block when calling f+                   -> Bool -- ^ hint that the buffer is not supposed to be modified by call of f+                   -> MutableBlockN n ty (PrimState prim)+                   -> (Ptr ty -> prim a)+                   -> prim a+withMutablePtrHint skipCopy skipCopyBack (MutableBlockN mb) f =+    B.withMutablePtrHint skipCopy skipCopyBack mb f
+ Basement/Sized/List.hs view
@@ -0,0 +1,384 @@+-- |+-- Module      : Basement.Sized.List+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A Nat-sized list abstraction+--+-- Using this module is limited to GHC 7.10 and above.+--+{-# LANGUAGE KindSignatures            #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE GADTs                     #-}+{-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE UndecidableInstances      #-}+{-# LANGUAGE AllowAmbiguousTypes       #-}+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE FlexibleContexts          #-}+module Basement.Sized.List+    ( ListN+    , toListN+    , toListN_+    , unListN+    , length+    , create+    , createFrom+    , empty+    , singleton+    , uncons+    , cons+    , unsnoc+    , snoc+    , index+    , indexStatic+    , updateAt+    , map+    , mapi+    , elem+    , foldl+    , foldl'+    , foldl1'+    , scanl'+    , scanl1'+    , foldr+    , foldr1+    , reverse+    , append+    , minimum+    , maximum+    , head+    , tail+    , init+    , take+    , drop+    , splitAt+    , zip, zip3, zip4, zip5+    , unzip+    , zipWith, zipWith3, zipWith4, zipWith5+    , replicate+    -- * Applicative And Monadic+    , replicateM+    , sequence+    , sequence_+    , mapM+    , mapM_+    ) where++import           Data.Proxy+import qualified Data.List+import           Basement.Compat.Base+import           Basement.Compat.CallStack+import           Basement.Compat.Natural+import           Basement.Nat+import           Basement.NormalForm+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.Types.OffsetSize+import           Basement.Compat.ExtList ((!!))+import qualified Prelude+import qualified Control.Monad as M (replicateM, mapM, mapM_, sequence, sequence_)++impossible :: HasCallStack => a+impossible = error "ListN: internal error: the impossible happened"++-- | A Typed-level sized List equivalent to [a]+newtype ListN (n :: Nat) a = ListN { unListN :: [a] }+    deriving (Eq,Ord,Typeable,Generic)++instance Show a => Show (ListN n a) where+    show (ListN l) = show l++instance NormalForm a => NormalForm (ListN n a) where+    toNormalForm (ListN l) = toNormalForm l++-- | Try to create a ListN from a List, succeeding if the length is correct+toListN :: forall (n :: Nat) a . (KnownNat n, NatWithinBound Int n) => [a] -> Maybe (ListN n a)+toListN l+    | expected == Prelude.fromIntegral (Prelude.length l) = Just (ListN l)+    | otherwise                                           = Nothing+  where+    expected = natValInt (Proxy :: Proxy n)++-- | Create a ListN from a List, expecting a given length+--+-- If this list contains more or less than the expected length of the resulting type,+-- then an asynchronous error is raised. use 'toListN' for a more friendly functions+toListN_ :: forall n a . (HasCallStack, NatWithinBound Int n, KnownNat n) => [a] -> ListN n a+toListN_ l+    | expected == got = ListN l+    | otherwise       = error ("toListN_: expecting list of " <> show expected <> " elements, got " <> show got <> " elements")+  where+    expected = natValInt (Proxy :: Proxy n)+    got      = Prelude.length l++-- | performs a monadic action n times, gathering the results in a List of size n.+replicateM :: forall (n :: Nat) m a . (NatWithinBound Int n, Monad m, KnownNat n) => m a -> m (ListN n a)+replicateM action = ListN <$> M.replicateM (Prelude.fromIntegral $ natVal (Proxy :: Proxy n)) action++-- | Evaluate each monadic action in the list sequentially, and collect the results.+sequence :: Monad m => ListN n (m a) -> m (ListN n a)+sequence (ListN l) = ListN <$> M.sequence l++-- | Evaluate each monadic action in the list sequentially, and ignore the results.+sequence_ :: Monad m => ListN n (m a) -> m ()+sequence_ (ListN l) = M.sequence_ l++-- | Map each element of a List to a monadic action, evaluate these+-- actions sequentially and collect the results+mapM :: Monad m => (a -> m b) -> ListN n a -> m (ListN n b)+mapM f (ListN l) = ListN <$> M.mapM f l++-- | Map each element of a List to a monadic action, evaluate these+-- actions sequentially and ignore the results+mapM_ :: Monad m => (a -> m b) -> ListN n a -> m ()+mapM_ f (ListN l) = M.mapM_ f l++-- | Create a list of n elements where each element is the element in argument+replicate :: forall (n :: Nat) a . (NatWithinBound Int n, KnownNat n) => a -> ListN n a+replicate a = ListN $ Prelude.replicate (Prelude.fromIntegral $ natVal (Proxy :: Proxy n)) a++-- | Decompose a list into its head and tail.+uncons :: (1 <= n) => ListN n a -> (a, ListN (n-1) a)+uncons (ListN (x:xs)) = (x, ListN xs)+uncons _ = impossible++-- | prepend an element to the list+cons :: a -> ListN n a -> ListN (n+1) a+cons a (ListN l) = ListN (a : l)++-- | Decompose a list into its first elements and the last.+unsnoc :: (1 <= n) => ListN n a -> (ListN (n-1) a, a)+unsnoc (ListN l) = (ListN $ Data.List.init l, Data.List.last l)++-- | append an element to the list+snoc :: ListN n a -> a -> ListN (n+1) a+snoc (ListN l) a = ListN (l Prelude.++ [a])++-- | Create an empty list of a+empty :: ListN 0 a+empty = ListN []++-- | Get the length of a list+length :: forall a (n :: Nat) . (KnownNat n, NatWithinBound Int n) => ListN n a -> CountOf a+length _ = CountOf $ natValInt (Proxy :: Proxy n)++-- | Create a new list of size n, repeately calling f from 0 to n-1+create :: forall a (n :: Nat) . KnownNat n => (Natural -> a) -> ListN n a+create f = ListN $ Prelude.map (f . Prelude.fromIntegral) [0..(len-1)]+  where+    len = natVal (Proxy :: Proxy n)++-- | Same as create but apply an offset+createFrom :: forall a (n :: Nat) (start :: Nat) . (KnownNat n, KnownNat start)+           => Proxy start -> (Natural -> a) -> ListN n a+createFrom p f = ListN $ Prelude.map (f . Prelude.fromIntegral) [idx..(idx+len-1)]+  where+    len = natVal (Proxy :: Proxy n)+    idx = natVal p++-- | create a list of 1 element+singleton :: a -> ListN 1 a+singleton a = ListN [a]++-- | Check if a list contains the element a+elem :: Eq a => a -> ListN n a -> Bool+elem a (ListN l) = Prelude.elem a l++-- | Append 2 list together returning the new list+append :: ListN n a -> ListN m a -> ListN (n+m) a+append (ListN l1) (ListN l2) = ListN (l1 <> l2)++-- | Get the maximum element of a list+maximum :: (Ord a, 1 <= n) => ListN n a -> a+maximum (ListN l) = Prelude.maximum l++-- | Get the minimum element of a list+minimum :: (Ord a, 1 <= n) => ListN n a -> a+minimum (ListN l) = Prelude.minimum l++-- | Get the head element of a list+head :: (1 <= n) => ListN n a -> a+head (ListN (x:_)) = x+head _ = impossible++-- | Get the tail of a list+tail :: (1 <= n) => ListN n a -> ListN (n-1) a+tail (ListN (_:xs)) = ListN xs+tail _ = impossible++-- | Get the list with the last element missing+init :: (1 <= n) => ListN n a -> ListN (n-1) a+init (ListN l) = ListN $ Data.List.init l++-- | Take m elements from the beggining of the list.+--+-- The number of elements need to be less or equal to the list in argument+take :: forall a (m :: Nat) (n :: Nat) . (KnownNat m, NatWithinBound Int m, m <= n) => ListN n a -> ListN m a+take (ListN l) = ListN (Prelude.take n l)+  where n = natValInt (Proxy :: Proxy m)++-- | Drop elements from a list keeping the m remaining elements+drop :: forall a d (m :: Nat) (n :: Nat) . (KnownNat d, NatWithinBound Int d, (n - m) ~ d, m <= n) => ListN n a -> ListN m a+drop (ListN l) = ListN (Prelude.drop n l)+  where n = natValInt (Proxy :: Proxy d)++-- | Split a list into two, returning 2 lists+splitAt :: forall a d (m :: Nat) (n :: Nat) . (KnownNat d, NatWithinBound Int d, (n - m) ~ d, m <= n) => ListN n a -> (ListN m a, ListN (n-m) a)+splitAt (ListN l) = let (l1, l2) = Prelude.splitAt n l in (ListN l1, ListN l2)+  where n = natValInt (Proxy :: Proxy d)++-- | Get the i'th elements+--+-- This only works with TypeApplication:+--+-- > indexStatic @1 (toListN_ [1,2,3] :: ListN 3 Int)+indexStatic :: forall i n a . (KnownNat i, CmpNat i n ~ 'LT, Offsetable a i) => ListN n a -> a+indexStatic (ListN l) = l !! (natValOffset (Proxy :: Proxy i))++-- | Get the i'the element+index :: ListN n ty -> Offset ty -> ty+index (ListN l) ofs = l !! ofs++-- | Update the value in a list at a specific location+updateAt :: forall n a+         .  Offset a+         -> (a -> a)+         -> ListN n a+         -> ListN n a+updateAt o f (ListN l) = ListN (doUpdate 0 l)+  where doUpdate _ []     = []+        doUpdate i (x:xs)+            | i == o      = f x : xs+            | otherwise   = x : doUpdate (i+1) xs++-- | Map all elements in a list+map :: (a -> b) -> ListN n a -> ListN n b+map f (ListN l) = ListN (Prelude.map f l)++-- | Map all elements in a list with an additional index+mapi :: (Natural -> a -> b) -> ListN n a -> ListN n b+mapi f (ListN l) = ListN . loop 0 $ l+  where loop _ []     = []+        loop i (x:xs) = f i x : loop (i+1) xs++-- | Fold all elements from left+foldl :: (b -> a -> b) -> b -> ListN n a -> b+foldl f acc (ListN l) = Prelude.foldl f acc l++-- | Fold all elements from left strictly+foldl' :: (b -> a -> b) -> b -> ListN n a -> b+foldl' f acc (ListN l) = Data.List.foldl' f acc l++-- | Fold all elements from left strictly with a first element+-- as the accumulator+foldl1' :: (1 <= n) => (a -> a -> a) -> ListN n a -> a+foldl1' f (ListN l) = Data.List.foldl1' f l++-- | Fold all elements from right+foldr :: (a -> b -> b) -> b -> ListN n a -> b+foldr f acc (ListN l) = Prelude.foldr f acc l++-- | Fold all elements from right assuming at least one element is in the list.+foldr1 :: (1 <= n) => (a -> a -> a) -> ListN n a -> a+foldr1 f (ListN l) = Prelude.foldr1 f l++-- | 'scanl' is similar to 'foldl', but returns a list of successive+-- reduced values from the left+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+scanl' :: (b -> a -> b) -> b -> ListN n a -> ListN (n+1) b+scanl' f initialAcc (ListN start) = ListN (go initialAcc start)+  where+    go !acc l = acc : case l of+                        []     -> []+                        (x:xs) -> go (f acc x) xs++-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1' :: (a -> a -> a) -> ListN n a -> ListN n a+scanl1' f (ListN l) = case l of+                        []     -> ListN []+                        (x:xs) -> ListN $ Data.List.scanl' f x xs++-- | Reverse a list+reverse :: ListN n a -> ListN n a+reverse (ListN l) = ListN (Prelude.reverse l)++-- | Zip 2 lists of the same size, returning a new list of+-- the tuple of each elements+zip :: ListN n a -> ListN n b -> ListN n (a,b)+zip (ListN l1) (ListN l2) = ListN (Prelude.zip l1 l2)++-- | Unzip a list of tuple, to 2 List of the deconstructed tuples+unzip :: ListN n (a,b) -> (ListN n a, ListN n b)+unzip l = (map fst l, map snd l)++-- | Zip 3 lists of the same size+zip3 :: ListN n a -> ListN n b -> ListN n c -> ListN n (a,b,c)+zip3 (ListN x1) (ListN x2) (ListN x3) = ListN (loop x1 x2 x3)+  where loop (l1:l1s) (l2:l2s) (l3:l3s) = (l1,l2,l3) : loop l1s l2s l3s+        loop []       _        _        = []+        loop _        _        _        = impossible++-- | Zip 4 lists of the same size+zip4 :: ListN n a -> ListN n b -> ListN n c -> ListN n d -> ListN n (a,b,c,d)+zip4 (ListN x1) (ListN x2) (ListN x3) (ListN x4) = ListN (loop x1 x2 x3 x4)+  where loop (l1:l1s) (l2:l2s) (l3:l3s) (l4:l4s) = (l1,l2,l3,l4) : loop l1s l2s l3s l4s+        loop []       _        _        _        = []+        loop _        _        _        _        = impossible++-- | Zip 5 lists of the same size+zip5 :: ListN n a -> ListN n b -> ListN n c -> ListN n d -> ListN n e -> ListN n (a,b,c,d,e)+zip5 (ListN x1) (ListN x2) (ListN x3) (ListN x4) (ListN x5) = ListN (loop x1 x2 x3 x4 x5)+  where loop (l1:l1s) (l2:l2s) (l3:l3s) (l4:l4s) (l5:l5s) = (l1,l2,l3,l4,l5) : loop l1s l2s l3s l4s l5s+        loop []       _        _        _        _        = []+        loop _        _        _        _        _        = impossible++-- | Zip 2 lists using a function+zipWith :: (a -> b -> x) -> ListN n a -> ListN n b -> ListN n x+zipWith f (ListN (v1:vs)) (ListN (w1:ws)) = ListN (f v1 w1 : unListN (zipWith f (ListN vs) (ListN ws)))+zipWith _ (ListN [])       _ = ListN []+zipWith _ _                _ = impossible++-- | Zip 3 lists using a function+zipWith3 :: (a -> b -> c -> x)+         -> ListN n a+         -> ListN n b+         -> ListN n c+         -> ListN n x+zipWith3 f (ListN (v1:vs)) (ListN (w1:ws)) (ListN (x1:xs)) =+    ListN (f v1 w1 x1 : unListN (zipWith3 f (ListN vs) (ListN ws) (ListN xs)))+zipWith3 _ (ListN []) _       _ = ListN []+zipWith3 _ _          _       _ = impossible++-- | Zip 4 lists using a function+zipWith4 :: (a -> b -> c -> d -> x)+         -> ListN n a+         -> ListN n b+         -> ListN n c+         -> ListN n d+         -> ListN n x+zipWith4 f (ListN (v1:vs)) (ListN (w1:ws)) (ListN (x1:xs)) (ListN (y1:ys)) =+    ListN (f v1 w1 x1 y1 : unListN (zipWith4 f (ListN vs) (ListN ws) (ListN xs) (ListN ys)))+zipWith4 _ (ListN []) _       _       _ = ListN []+zipWith4 _ _          _       _       _ = impossible++-- | Zip 5 lists using a function+zipWith5 :: (a -> b -> c -> d -> e -> x)+         -> ListN n a+         -> ListN n b+         -> ListN n c+         -> ListN n d+         -> ListN n e+         -> ListN n x+zipWith5 f (ListN (v1:vs)) (ListN (w1:ws)) (ListN (x1:xs)) (ListN (y1:ys)) (ListN (z1:zs)) =+    ListN (f v1 w1 x1 y1 z1 : unListN (zipWith5 f (ListN vs) (ListN ws) (ListN xs) (ListN ys) (ListN zs)))+zipWith5 _ (ListN []) _       _       _       _ = ListN []+zipWith5 _ _          _       _       _       _ = impossible
+ Basement/Sized/UVect.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ConstraintKinds            #-}+module Basement.Sized.UVect+    ( UVect+    , MUVect+    , unUVect+    , toUVect+    , empty+    , singleton+    , replicate+    , thaw+    , freeze+    , index+    , map+    , foldl'+    , foldr+    , cons+    , snoc+    , elem+    , sub+    , uncons+    , unsnoc+    , splitAt+    , all+    , any+    , find+    , reverse+    , sortBy+    , intersperse+    ) where++import           Basement.Compat.Base+import           Basement.Nat+import           Basement.NormalForm+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.PrimType (PrimType)+import qualified Basement.UArray as A+import qualified Basement.UArray.Mutable as A hiding (sub)+import           Data.Proxy++newtype UVect (n :: Nat) a = UVect { unUVect :: A.UArray a } deriving (NormalForm, Eq, Show)+newtype MUVect (n :: Nat) ty st = MUVect { unMUVect :: A.MUArray ty st }++toUVect :: forall n ty . (PrimType ty, KnownNat n, Countable ty n) => A.UArray ty -> Maybe (UVect n ty)+toUVect b+    | expected == A.length b = Just (UVect b)+    | otherwise              = Nothing+  where+    expected = toCount @n++empty :: PrimType ty => UVect 0 ty+empty = UVect mempty++singleton :: PrimType ty => ty -> UVect 1 ty+singleton a = UVect (A.singleton a)++create :: forall ty (n :: Nat) . (PrimType ty, Countable ty n, KnownNat n) => (Offset ty -> ty) -> UVect n ty+create f = UVect $ A.create sz f+  where+    sz = natValCountOf (Proxy :: Proxy n)++replicate :: forall n ty . (KnownNat n, Countable ty n, PrimType ty) => ty -> UVect n ty+replicate a = UVect (A.replicate (toCount @n) a)++thaw :: (KnownNat n, PrimMonad prim, PrimType ty) => UVect n ty -> prim (MUVect n ty (PrimState prim))+thaw b = MUVect <$> A.thaw (unUVect b)++freeze ::  (PrimMonad prim, PrimType ty, Countable ty n) => MUVect n ty (PrimState prim) -> prim (UVect n ty)+freeze b = UVect <$> A.freeze (unMUVect b)++write :: (PrimMonad prim, PrimType ty) => MUVect n ty (PrimState prim) -> Offset ty -> ty -> prim ()+write (MUVect ma) ofs v = A.write ma ofs v++read :: (PrimMonad prim, PrimType ty) => MUVect n ty (PrimState prim) -> Offset ty -> prim ty+read (MUVect ma) ofs = A.read ma ofs++indexStatic :: forall i n ty . (KnownNat i, CmpNat i n ~ 'LT, PrimType ty, Offsetable ty i) => UVect n ty -> ty+indexStatic b = A.unsafeIndex (unUVect b) (toOffset @i)++index :: forall i n ty . PrimType ty => UVect n ty -> Offset ty -> ty+index b ofs = A.index (unUVect b) ofs++map :: (PrimType a, PrimType b) => (a -> b) -> UVect n a -> UVect n b+map f b = UVect (A.map f (unUVect b))++foldl' :: PrimType ty => (a -> ty -> a) -> a -> UVect n ty -> a+foldl' f acc b = A.foldl' f acc (unUVect b)++foldr :: PrimType ty => (ty -> a -> a) -> a -> UVect n ty -> a+foldr f acc b = A.foldr f acc (unUVect b)++cons :: PrimType ty => ty -> UVect n ty -> UVect (n+1) ty+cons e = UVect . A.cons e . unUVect++snoc :: PrimType ty => UVect n ty -> ty -> UVect (n+1) ty+snoc b = UVect . A.snoc (unUVect b)++sub :: forall i j n ty+     . ( (i <=? n) ~ 'True+       , (j <=? n) ~ 'True+       , (i <=? j) ~ 'True+       , PrimType ty+       , KnownNat i+       , KnownNat j+       , Offsetable ty i+       , Offsetable ty j )+    => UVect n ty+    -> UVect (j-i) ty+sub block = UVect (A.sub (unUVect block) (toOffset @i) (toOffset @j))++uncons :: forall n ty . (CmpNat 0 n ~ 'LT, PrimType ty, KnownNat n, Offsetable ty n)+       => UVect n ty+       -> (ty, UVect (n-1) ty)+uncons b = (indexStatic @0 b, UVect (A.sub (unUVect b) 1 (toOffset @n)))++unsnoc :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, PrimType ty, Offsetable ty n)+       => UVect n ty+       -> (UVect (n-1) ty, ty)+unsnoc b =+    ( UVect (A.sub (unUVect b) 0 (toOffset @n `offsetSub` 1))+    , A.unsafeIndex (unUVect b) (toOffset @n `offsetSub` 1))++splitAt :: forall i n ty . (CmpNat i n ~ 'LT, PrimType ty, KnownNat i, Countable ty i) => UVect n ty -> (UVect i ty, UVect (n-i) ty)+splitAt b =+    let (left, right) = A.splitAt (toCount @i) (unUVect b)+     in (UVect left, UVect right)++elem :: PrimType ty => ty -> UVect n ty -> Bool+elem e b = A.elem e (unUVect b)++all :: PrimType ty => (ty -> Bool) -> UVect n ty -> Bool+all p b = A.all p (unUVect b)++any :: PrimType ty => (ty -> Bool) -> UVect n ty -> Bool+any p b = A.any p (unUVect b)++find :: PrimType ty => (ty -> Bool) -> UVect n ty -> Maybe ty+find p b = A.find p (unUVect b)++reverse :: PrimType ty => UVect n ty -> UVect n ty+reverse = UVect . A.reverse . unUVect++sortBy :: PrimType ty => (ty -> ty -> Ordering) -> UVect n ty -> UVect n ty+sortBy f b = UVect (A.sortBy f (unUVect b))++intersperse :: (CmpNat n 1 ~ 'GT, PrimType ty) => ty -> UVect n ty -> UVect (n+n-1) ty+intersperse sep b = UVect (A.intersperse sep (unUVect b))++toCount :: forall n ty . (KnownNat n, Countable ty n) => CountOf ty+toCount = natValCountOf (Proxy @n)++toOffset :: forall n ty . (KnownNat n, Offsetable ty n) => Offset ty+toOffset = natValOffset (Proxy @n)
+ Basement/Sized/Vect.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE AllowAmbiguousTypes        #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ConstraintKinds            #-}+module Basement.Sized.Vect+    ( Vect+    , MVect+    , unVect+    , toVect+    , empty+    , singleton+    , replicate+    , thaw+    , freeze+    , index+    , map+    , foldl'+    , foldr+    , cons+    , snoc+    , elem+    , sub+    , uncons+    , unsnoc+    , splitAt+    , all+    , any+    , find+    , reverse+    , sortBy+    , intersperse+    ) where++import           Basement.Compat.Base+import           Basement.Nat+import           Basement.NormalForm+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.PrimType (PrimType)+import qualified Basement.BoxedArray as A+--import qualified Basement.BoxedArray.Mutable as A hiding (sub)+import           Data.Proxy++newtype Vect (n :: Nat) a = Vect { unVect :: A.Array a } deriving (NormalForm, Eq, Show)+newtype MVect (n :: Nat) ty st = MVect { unMVect :: A.MArray ty st }++instance Functor (Vect n) where+    fmap = map++toVect :: forall n ty . (KnownNat n, Countable ty n) => A.Array ty -> Maybe (Vect n ty)+toVect b+    | expected == A.length b = Just (Vect b)+    | otherwise = Nothing+  where+    expected = toCount @n++empty :: Vect 0 ty+empty = Vect A.empty++singleton :: ty -> Vect 1 ty+singleton a = Vect (A.singleton a)++create :: forall a (n :: Nat) . (Countable a n, KnownNat n) => (Offset a -> a) -> Vect n a+create f = Vect $ A.create sz f+  where+    sz = natValCountOf (Proxy :: Proxy n)++replicate :: forall n ty . (KnownNat n, Countable ty n) => ty -> Vect n ty+replicate a = Vect (A.replicate (toCount @n) a)++thaw :: (KnownNat n, PrimMonad prim) => Vect n ty -> prim (MVect n ty (PrimState prim))+thaw b = MVect <$> A.thaw (unVect b)++freeze ::  (PrimMonad prim, Countable ty n) => MVect n ty (PrimState prim) -> prim (Vect n ty)+freeze b = Vect <$> A.freeze (unMVect b)++write :: PrimMonad prim => MVect n ty (PrimState prim) -> Offset ty -> ty -> prim ()+write (MVect ma) ofs v = A.write ma ofs v++read :: PrimMonad prim => MVect n ty (PrimState prim) -> Offset ty -> prim ty+read (MVect ma) ofs = A.read ma ofs++indexStatic :: forall i n ty . (KnownNat i, CmpNat i n ~ 'LT, Offsetable ty i) => Vect n ty -> ty+indexStatic b = A.unsafeIndex (unVect b) (toOffset @i)++index :: Vect n ty -> Offset ty -> ty+index b ofs = A.index (unVect b) ofs++map :: (a -> b) -> Vect n a -> Vect n b+map f b = Vect (fmap f (unVect b))++foldl' :: (a -> ty -> a) -> a -> Vect n ty -> a+foldl' f acc b = A.foldl' f acc (unVect b)++foldr :: (ty -> a -> a) -> a -> Vect n ty -> a+foldr f acc b = A.foldr f acc (unVect b)++cons :: ty -> Vect n ty -> Vect (n+1) ty+cons e = Vect . A.cons e . unVect++snoc :: Vect n ty -> ty -> Vect (n+1) ty+snoc b = Vect . A.snoc (unVect b)++sub :: forall i j n ty+     . ( (i <=? n) ~ 'True+       , (j <=? n) ~ 'True+       , (i <=? j) ~ 'True+       , KnownNat i+       , KnownNat j+       , Offsetable ty i+       , Offsetable ty j )+    => Vect n ty+    -> Vect (j-i) ty+sub block = Vect (A.sub (unVect block) (toOffset @i) (toOffset @j))++uncons :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, Offsetable ty n)+       => Vect n ty+       -> (ty, Vect (n-1) ty)+uncons b = (indexStatic @0 b, Vect (A.sub (unVect b) 1 (toOffset @n)))++unsnoc :: forall n ty . (CmpNat 0 n ~ 'LT, KnownNat n, Offsetable ty n)+       => Vect n ty+       -> (Vect (n-1) ty, ty)+unsnoc b =+    ( Vect (A.sub (unVect b) 0 (toOffset @n `offsetSub` 1))+    , A.unsafeIndex (unVect b) (toOffset @n `offsetSub` 1))++splitAt :: forall i n ty . (CmpNat i n ~ 'LT, KnownNat i, Countable ty i) => Vect n ty -> (Vect i ty, Vect (n-i) ty)+splitAt b =+    let (left, right) = A.splitAt (toCount @i) (unVect b)+     in (Vect left, Vect right)++elem :: Eq ty => ty -> Vect n ty -> Bool+elem e b = A.elem e (unVect b)++all :: (ty -> Bool) -> Vect n ty -> Bool+all p b = A.all p (unVect b)++any :: (ty -> Bool) -> Vect n ty -> Bool+any p b = A.any p (unVect b)++find :: (ty -> Bool) -> Vect n ty -> Maybe ty+find p b = A.find p (unVect b)++reverse :: Vect n ty -> Vect n ty+reverse = Vect . A.reverse . unVect++sortBy :: (ty -> ty -> Ordering) -> Vect n ty -> Vect n ty+sortBy f b = Vect (A.sortBy f (unVect b))++intersperse :: (CmpNat n 1 ~ 'GT) => ty -> Vect n ty -> Vect (n+n-1) ty+intersperse sep b = Vect (A.intersperse sep (unVect b))++toCount :: forall n ty . (KnownNat n, Countable ty n) => CountOf ty+toCount = natValCountOf (Proxy @n)++toOffset :: forall n ty . (KnownNat n, Offsetable ty n) => Offset ty+toOffset = natValOffset (Proxy @n)
+ Basement/String.hs view
@@ -0,0 +1,1465 @@+-- |+-- Module      : Basement.String+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A String type backed by a UTF8 encoded byte array and all the necessary+-- functions to manipulate the string.+--+-- You can think of String as a specialization of a byte array that+-- have element of type Char.+--+-- The String data must contain UTF8 valid data.+--+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE CPP                        #-}+module Basement.String+    ( String(..)+    , MutableString(..)+    , create+    , replicate+    , length+    -- * Binary conversion+    , Encoding(..)+    , fromBytes+    , fromChunkBytes+    , fromBytesUnsafe+    , fromBytesLenient+    , toBytes+    , mutableValidate+    , copy+    , ValidationFailure(..)+    , index+    , null+    , drop+    , take+    , splitAt+    , revDrop+    , revTake+    , revSplitAt+    , splitOn+    , sub+    , elem+    , indices+    , intersperse+    , span+    , spanEnd+    , break+    , breakEnd+    , breakElem+    , breakLine+    , dropWhile+    , singleton+    , charMap+    , snoc+    , cons+    , unsnoc+    , uncons+    , find+    , findIndex+    , sortBy+    , filter+    , reverse+    , replace+    , builderAppend+    , builderBuild+    , builderBuild_+    , readInteger+    , readIntegral+    , readNatural+    , readDouble+    , readRational+    , readFloatingExact+    , upper+    , lower+    , caseFold+    , isPrefixOf+    , isSuffixOf+    , isInfixOf+    , stripPrefix+    , stripSuffix+    , all+    , any+    -- * Legacy utility+    , lines+    , words+    , toBase64+    , toBase64URL+    , toBase64OpenBSD+    ) where++import           Basement.UArray           (UArray)+import qualified Basement.UArray           as Vec+import qualified Basement.UArray           as C+import qualified Basement.UArray.Mutable   as MVec+import           Basement.Block.Mutable (Block(..), MutableBlock(..))+import qualified Basement.Block.Mutable    as MBLK+import           Basement.Compat.Bifunctor+import           Basement.Compat.Base+import           Basement.Compat.Natural+import           Basement.Compat.MonadTrans+import           Basement.Compat.Primitive+import           Basement.Types.OffsetSize+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.Numerical.Multiplicative+import           Basement.Numerical.Number+import           Basement.Cast+import           Basement.Monad+import           Basement.PrimType+import           Basement.FinalPtr+import           Basement.IntegralConv+import           Basement.Floating+import           Basement.MutableBuilder+import           Basement.String.CaseMapping (upperMapping, lowerMapping, foldMapping)+import           Basement.UTF8.Table+import           Basement.UTF8.Helper+import           Basement.UTF8.Base+import           Basement.UTF8.Types+import           Basement.UArray.Base as C (onBackendPrim, onBackend, onBackendPure, offset, ValidRange(..), offsetsValidRange, MUArray(..), MUArrayBackend(..))+import           Basement.Alg.Class (Indexable)+import qualified Basement.Alg.UTF8 as UTF8+import qualified Basement.Alg.String as Alg+import           Basement.Types.Char7 (Char7(..), c7Upper, c7Lower)+import qualified Basement.Types.Char7 as Char7+import           Basement.HeadHackageUtils+import           GHC.Prim+import           GHC.ST+import           GHC.Types+import           GHC.Word+#if MIN_VERSION_base(4,9,0)+import           GHC.Char+#endif++ -- temporary+import qualified Data.List+import           Data.Ratio+import           Data.Char (toUpper, toLower)+import qualified Prelude++import qualified Basement.String.Encoding.Encoding   as Encoder+import qualified Basement.String.Encoding.ASCII7     as Encoder+import qualified Basement.String.Encoding.UTF16      as Encoder+import qualified Basement.String.Encoding.UTF32      as Encoder+import qualified Basement.String.Encoding.ISO_8859_1 as Encoder++-- | UTF8 Encoder+data EncoderUTF8 = EncoderUTF8++instance Encoder.Encoding EncoderUTF8 where+    type Unit EncoderUTF8 = Word8+    type Error EncoderUTF8 = ValidationFailure+    encodingNext  _ = \ofs -> Right . nextWithIndexer ofs+    encodingWrite _ = writeWithBuilder++-- | Validate a bytearray for UTF8'ness+--+-- On success Nothing is returned+-- On Failure the position along with the failure reason+validate :: UArray Word8+         -> Offset8+         -> CountOf Word8+         -> (Offset8, Maybe ValidationFailure)+validate array ofsStart sz = C.unsafeDewrap goBa goAddr array+  where+    unTranslateOffset start = first (\e -> e `offsetSub` start)+    goBa ba start =+        unTranslateOffset start $ Alg.validate (start+end) ba (start + ofsStart)+    goAddr ptr@(Ptr !_) start =+        pure $ unTranslateOffset start $ Alg.validate (start+end) ptr (ofsStart + start)+    end = ofsStart `offsetPlusE` sz++-- | Similar to 'validate' but works on a 'MutableByteArray'+mutableValidate :: PrimMonad prim+                => MVec.MUArray Word8 (PrimState prim)+                -> Offset Word8+                -> CountOf Word8+                -> prim (Offset Word8, Maybe ValidationFailure)+mutableValidate mba ofsStart sz = do+    loop ofsStart+  where+    end = ofsStart `offsetPlusE` sz++    loop ofs+        | ofs > end  = error "mutableValidate: internal error: went pass offset"+        | ofs == end = return (end, Nothing)+        | otherwise  = do+            r <- one ofs+            case r of+                (nextOfs, Nothing)  -> loop nextOfs+                (pos, Just failure) -> return (pos, Just failure)++    one pos = do+        h <- StepASCII <$> Vec.unsafeRead mba pos+        let nbConts = getNbBytes h+        if nbConts == 0xff+            then return (pos, Just InvalidHeader)+            else if pos + 1 + Offset nbConts > end+                then return (pos, Just MissingByte)+                else do+                    case nbConts of+                        0 -> return (pos + 1, Nothing)+                        1 -> do+                            c1 <- Vec.unsafeRead mba (pos + 1)+                            if isContinuation c1+                                then return (pos + 2, Nothing)+                                else return (pos, Just InvalidContinuation)+                        2 -> do+                            c1 <- Vec.unsafeRead mba (pos + 1)+                            c2 <- Vec.unsafeRead mba (pos + 2)+                            if isContinuation c1 && isContinuation c2+                                then return (pos + 3, Nothing)+                                else return (pos, Just InvalidContinuation)+                        3 -> do+                            c1 <- Vec.unsafeRead mba (pos + 1)+                            c2 <- Vec.unsafeRead mba (pos + 2)+                            c3 <- Vec.unsafeRead mba (pos + 3)+                            if isContinuation c1 && isContinuation c2 && isContinuation c3+                                then return (pos + 4, Nothing)+                                else return (pos, Just InvalidContinuation)+                        _ -> error "internal error"++nextWithIndexer :: (Offset Word8 -> Word8)+                -> Offset Word8+                -> (Char, Offset Word8)+nextWithIndexer getter off =+    case getNbBytes# (word8ToWordCompat# h) of+        0# -> (toChar (word8ToWordCompat# h), off + 1)+        1# -> (toChar (decode2 (getter $ off + 1)), off + 2)+        2# -> (toChar (decode3 (getter $ off + 1) (getter $ off + 2)), off + 3)+        3# -> (toChar (decode4 (getter $ off + 1) (getter $ off + 2) (getter $ off + 3))+              , off + 4)+        r -> error ("next: internal error: invalid input: " <> show (I# r) <> " " <> show (W# (word8ToWordCompat# h)))+  where+    !(W8# h) = getter off++    toChar :: Word# -> Char+    toChar w = C# (chr# (word2Int# w))++    decode2 :: Word8 -> Word#+    decode2 (W8# c1) =+        or# (uncheckedShiftL# (and# (word8ToWordCompat# h) 0x1f##) 6#)+            (and# (word8ToWordCompat# c1) 0x3f##)++    decode3 :: Word8 -> Word8 -> Word#+    decode3 (W8# c1) (W8# c2) =+        or# (uncheckedShiftL# (and# (word8ToWordCompat# h) 0xf##) 12#)+            (or# (uncheckedShiftL# (and# (word8ToWordCompat# c1) 0x3f##) 6#)+                 (and# (word8ToWordCompat# c2) 0x3f##))++    decode4 :: Word8 -> Word8 -> Word8 -> Word#+    decode4 (W8# c1) (W8# c2) (W8# c3) =+        or# (uncheckedShiftL# (and# (word8ToWordCompat# h) 0x7##) 18#)+            (or# (uncheckedShiftL# (and# (word8ToWordCompat# c1) 0x3f##) 12#)+                (or# (uncheckedShiftL# (and# (word8ToWordCompat# c2) 0x3f##) 6#)+                    (and# (word8ToWordCompat# c3) 0x3f##))+            )++writeWithBuilder :: (PrimMonad st, Monad st)+                 => Char+                 -> Builder (UArray Word8) (MVec.MUArray Word8) Word8 st err ()+writeWithBuilder c+    | bool# (ltWord# x 0x80##   ) = encode1+    | bool# (ltWord# x 0x800##  ) = encode2+    | bool# (ltWord# x 0x10000##) = encode3+    | otherwise = encode4+  where+    !(I# xi) = fromEnum c+    !x       = int2Word# xi++    encode1 = Vec.builderAppend (W8# (wordToWord8Compat# x))++    encode2 = do+        let x1  = or# (uncheckedShiftRL# x 6#) 0xc0##+            x2  = toContinuation x+        Vec.builderAppend (W8# (wordToWord8Compat# x1)) >> Vec.builderAppend (W8# (wordToWord8Compat# x2))++    encode3 = do+        let x1  = or# (uncheckedShiftRL# x 12#) 0xe0##+            x2  = toContinuation (uncheckedShiftRL# x 6#)+            x3  = toContinuation x+        Vec.builderAppend (W8# (wordToWord8Compat# x1)) >> Vec.builderAppend (W8# (wordToWord8Compat# x2)) >> Vec.builderAppend (W8# (wordToWord8Compat# x3))++    encode4 = do+        let x1  = or# (uncheckedShiftRL# x 18#) 0xf0##+            x2  = toContinuation (uncheckedShiftRL# x 12#)+            x3  = toContinuation (uncheckedShiftRL# x 6#)+            x4  = toContinuation x+        Vec.builderAppend (W8# (wordToWord8Compat# x1)) >> Vec.builderAppend (W8# (wordToWord8Compat# x2)) >> Vec.builderAppend (W8# (wordToWord8Compat# x3)) >> Vec.builderAppend (W8# (wordToWord8Compat# x4))++    toContinuation :: Word# -> Word#+    toContinuation w = or# (and# w 0x3f##) 0x80##++writeUTF8Char :: PrimMonad prim => MutableString (PrimState prim) -> Offset8 -> UTF8Char -> prim ()+writeUTF8Char (MutableString mba) i (UTF8_1 x1) =+    Vec.unsafeWrite mba i     x1+writeUTF8Char (MutableString mba) i (UTF8_2 x1 x2) = do+    Vec.unsafeWrite mba i     x1+    Vec.unsafeWrite mba (i+1) x2+writeUTF8Char (MutableString mba) i (UTF8_3 x1 x2 x3) = do+    Vec.unsafeWrite mba i     x1+    Vec.unsafeWrite mba (i+1) x2+    Vec.unsafeWrite mba (i+2) x3+writeUTF8Char (MutableString mba) i (UTF8_4 x1 x2 x3 x4) = do+    Vec.unsafeWrite mba i     x1+    Vec.unsafeWrite mba (i+1) x2+    Vec.unsafeWrite mba (i+2) x3+    Vec.unsafeWrite mba (i+3) x4+{-# INLINE writeUTF8Char #-}++unsafeFreezeShrink :: PrimMonad prim => MutableString (PrimState prim) -> CountOf Word8 -> prim String+unsafeFreezeShrink (MutableString mba) s = String <$> Vec.unsafeFreezeShrink mba s+{-# INLINE unsafeFreezeShrink #-}++------------------------------------------------------------------------+-- real functions++-- | Check if a String is null+null :: String -> Bool+null (String ba) = C.length ba == 0++-- we don't know in constant time the count of character in string,+-- however if we estimate bounds of what N characters would+-- take in space (between N and N*4). If the count is thus bigger than+-- the number of bytes, then we know for sure that it's going to+-- be out of bounds+countCharMoreThanBytes :: CountOf Char -> UArray Word8 -> Bool+countCharMoreThanBytes (CountOf chars) ba = chars >= bytes+  where (CountOf bytes) = C.length ba++-- | Create a string composed of a number @n of Chars (Unicode code points).+--+-- if the input @s contains less characters than required, then the input string is returned.+take :: CountOf Char -> String -> String+take n s@(String ba)+    | n <= 0                      = mempty+    | countCharMoreThanBytes n ba = s+    | otherwise                   = String $ Vec.unsafeTake (offsetAsSize $ indexN n s) ba++-- | Create a string with the remaining Chars after dropping @n Chars from the beginning+drop :: CountOf Char -> String -> String+drop n s@(String ba)+    | n <= 0                      = s+    | countCharMoreThanBytes n ba = mempty+    | otherwise                   = String $ Vec.drop (offsetAsSize $ indexN n s) ba++-- | Split a string at the Offset specified (in Char) returning both+-- the leading part and the remaining part.+splitAt :: CountOf Char -> String -> (String, String)+splitAt n s@(String ba)+    | n <= 0                      = (mempty, s)+    | countCharMoreThanBytes n ba = (s, mempty)+    | otherwise                   =+        let (v1,v2) = C.splitAt (offsetAsSize $ indexN n s) ba+         in (String v1, String v2)++-- | Return the offset (in bytes) of the N'th sequence in an UTF8 String+indexN :: CountOf Char -> String -> Offset Word8+indexN !n (String ba) = Vec.unsafeDewrap goVec goAddr ba+  where+    goVec :: Block Word8 -> Offset Word8 -> Offset Word8+    goVec (Block !ma) !start = loop start 0+      where+        !len = start `offsetPlusE` Vec.length ba+        loop :: Offset Word8 -> Offset Char -> Offset Word8+        loop !idx !i+            | idx >= len || i .==# n = sizeAsOffset (idx - start)+            | otherwise              = loop (idx `offsetPlusE` d) (i + Offset 1)+          where d = skipNextHeaderValue (primBaIndex ma idx)+    {-# INLINE goVec #-}++    goAddr :: Ptr Word8 -> Offset Word8 -> ST s (Offset Word8)+    goAddr (Ptr ptr) !start = return $ loop start (Offset 0)+      where+        !len = start `offsetPlusE` Vec.length ba+        loop :: Offset Word8 -> Offset Char -> Offset Word8+        loop !idx !i+            | idx >= len || i .==# n = sizeAsOffset (idx - start)+            | otherwise              = loop (idx `offsetPlusE` d) (i + Offset 1)+          where d = skipNextHeaderValue (primAddrIndex ptr idx)+    {-# INLINE goAddr #-}+{-# INLINE indexN #-}++-- inverse a CountOf that is specified from the end (e.g. take n Chars from the end)+--+-- rev{Take,Drop,SplitAt} TODO optimise:+-- we can process the string from the end using a skipPrev instead of getting the length+countFromStart :: String -> CountOf Char -> CountOf Char+countFromStart s sz@(CountOf sz')+    | sz >= len = CountOf 0+    | otherwise = CountOf (len' - sz')+  where len@(CountOf len') = length s++-- | Similar to 'take' but from the end+revTake :: CountOf Char -> String -> String+revTake n v = drop (countFromStart v n) v++-- | Similar to 'drop' but from the end+revDrop :: CountOf Char -> String -> String+revDrop n v = take (countFromStart v n) v++-- | Similar to 'splitAt' but from the end+revSplitAt :: CountOf Char -> String -> (String, String)+revSplitAt n v = (drop idx v, take idx v) where idx = countFromStart v n++-- | Split on the input string using the predicate as separator+--+-- e.g.+--+-- > splitOn (== ',') ","          == ["",""]+-- > splitOn (== ',') ",abc,"      == ["","abc",""]+-- > splitOn (== ':') "abc"        == ["abc"]+-- > splitOn (== ':') "abc::def"   == ["abc","","def"]+-- > splitOn (== ':') "::abc::def" == ["","","abc","","def"]+--+splitOn :: (Char -> Bool) -> String -> [String]+splitOn predicate s+    | sz == CountOf 0 = [mempty]+    | otherwise    = loop azero azero+  where+    !sz = size s+    end = azero `offsetPlusE` sz+    loop prevIdx idx+        | idx == end = [sub s prevIdx idx]+        | otherwise =+            let !(Step c idx') = next s idx+             in if predicate c+                    then sub s prevIdx idx : loop idx' idx'+                    else loop prevIdx idx'++-- | Internal call to make a substring given offset in bytes.+--+-- This is unsafe considering that one can create a substring+-- starting and/or ending on the middle of a UTF8 sequence.+sub :: String -> Offset8 -> Offset8 -> String+sub (String ba) start end = String $ Vec.sub ba start end++-- | Internal call to split at a given index in offset of bytes.+--+-- This is unsafe considering that one can split in the middle of a+-- UTF8 sequence, so use with care.+splitIndex :: Offset8 -> String -> (String, String)+splitIndex idx (String ba) = (String v1, String v2)+  where (v1,v2) = C.splitAt (offsetAsSize idx) ba++-- | Break a string into 2 strings at the location where the predicate return True+break :: (Char -> Bool) -> String -> (String, String)+break predicate s@(String ba) = runST $ Vec.unsafeIndexer ba go+  where+    !sz = size s+    end = azero `offsetPlusE` sz++    go :: (Offset Word8 -> Word8) -> ST st (String, String)+    go getIdx = loop (Offset 0)+      where+        !nextI = nextWithIndexer getIdx+        loop idx+            | idx == end = return (s, mempty)+            | otherwise  = do+                let (c, idx') = nextI idx+                case predicate c of+                    True  -> return $ splitIndex idx s+                    False -> loop idx'+        {-# INLINE loop #-}+{-# INLINE [2] break #-}++breakEnd :: (Char -> Bool) -> String -> (String, String)+breakEnd predicate s@(String arr)+    | k == end  = (s, mempty)+    | otherwise = splitIndex (k `offsetSub` start) s+  where+    k = C.onBackend goVec (\_ -> pure . goAddr) arr+    (C.ValidRange !start !end) = offsetsValidRange arr+    goVec ba@(Block !_) = let k = Alg.revFindIndexPredicate predicate ba start end+                        in if k == end then end else UTF8.nextSkip ba k+    goAddr ptr@(Ptr !_) =+        let k = Alg.revFindIndexPredicate predicate ptr start end+         in if k == end then end else UTF8.nextSkip ptr k+{-# INLINE [2] breakEnd #-}++#if MIN_VERSION_base(4,9,0)+{-# RULES "break (== 'c')" [3] forall c . break (eqChar c) = breakElem c #-}+#else+{-# RULES "break (== 'c')" [3] forall c . break (== c) = breakElem c #-}+#endif++-- | Break a string into 2 strings at the first occurence of the character+breakElem :: Char -> String -> (String, String)+breakElem !el s@(String ba)+    | sz == 0   = (mempty, mempty)+    | otherwise =+        case asUTF8Char el of+            UTF8_1 w -> let !(v1,v2) = Vec.breakElem w ba in (String v1, String v2)+            _        -> runST $ Vec.unsafeIndexer ba go+  where+    sz = size s+    end = azero `offsetPlusE` sz++    go :: (Offset Word8 -> Word8) -> ST st (String, String)+    go getIdx = loop (Offset 0)+      where+        !nextI = nextWithIndexer getIdx+        loop idx+            | idx == end = return (s, mempty)+            | otherwise  = do+                let (c, idx') = nextI idx+                case el == c of+                    True  -> return $ splitIndex idx s+                    False -> loop idx'++-- | Same as break but cut on a line feed with an optional carriage return.+--+-- This is the same operation as 'breakElem LF' dropping the last character of the+-- string if it's a CR.+--+-- Also for efficiency reason (streaming), it returns if the last character was a CR character.+breakLine :: String -> Either Bool (String, String)+breakLine (String arr) = bimap String String <$> Vec.breakLine arr++-- | Apply a @predicate@ to the string to return the longest prefix that satisfy the predicate and+-- the remaining+span :: (Char -> Bool) -> String -> (String, String)+span predicate s = break (not . predicate) s++-- | Apply a @predicate@ to the string to return the longest suffix that satisfy the predicate and+-- the remaining+spanEnd :: (Char -> Bool) -> String -> (String, String)+spanEnd predicate s = breakEnd (not . predicate) s++-- | Drop character from the beginning while the predicate is true+dropWhile :: (Char -> Bool) -> String -> String+dropWhile predicate = snd . break (not . predicate)++-- | Return whereas the string contains a specific character or not+elem :: Char -> String -> Bool+elem !el s@(String ba) =+    case asUTF8Char el of+        UTF8_1 w -> Vec.elem w ba+        _        -> runST $ Vec.unsafeIndexer ba go+  where+    sz = size s+    end = azero `offsetPlusE` sz++    go :: (Offset Word8 -> Word8) -> ST st Bool+    go getIdx = loop (Offset 0)+      where+        !nextI = nextWithIndexer getIdx+        loop !idx+            | idx == end = return False+            | otherwise  = do+                let (c, idx') = nextI idx+                case el == c of+                    True  -> return True+                    False -> loop idx'++-- | Intersperse the character @sep@ between each character in the string+--+-- > intersperse ' ' "Hello Foundation"+-- "H e l l o   F o u n d a t i o n"+intersperse :: Char -> String -> String+intersperse sep src = case length src - 1 of+    Nothing   -> src+    Just 0    -> src+    Just gaps -> runST $ unsafeCopyFrom src dstBytes go+        where+          lastSrcI :: Offset Char+          lastSrcI = 0 `offsetPlusE` gaps+          dstBytes = (size src :: CountOf Word8) + (gaps `scale` charToBytes (fromEnum sep))++          go :: String -> Offset Char -> Offset8 -> MutableString s -> Offset8 -> ST s (Offset8, Offset8)+          go src' srcI srcIdx dst dstIdx+              | srcI == lastSrcI = do+                  nextDstIdx <- write dst dstIdx c+                  return (nextSrcIdx, nextDstIdx)+              | otherwise        = do+                  nextDstIdx  <- write dst dstIdx c+                  nextDstIdx' <- write dst nextDstIdx sep+                  return (nextSrcIdx, nextDstIdx')+            where+              !(Step c nextSrcIdx) = next src' srcIdx++-- | Allocate a new @String@ with a fill function that has access to the characters of+--   the source @String@.+unsafeCopyFrom :: String -- ^ Source string+               -> CountOf Word8  -- ^ Length of the destination string in bytes+               -> (String -> Offset Char -> Offset8 -> MutableString s -> Offset8 -> ST s (Offset8, Offset8))+               -- ^ Function called for each character in the source String+               -> ST s String -- ^ Returns the filled new string+unsafeCopyFrom src dstBytes f = new dstBytes >>= fill (Offset 0) (Offset 0) (Offset 0) f >>= freeze+  where+    srcLen = length src+    end = Offset 0 `offsetPlusE` srcLen+    fill srcI srcIdx dstIdx f' dst'+        | srcI == end = return dst'+        | otherwise = do (nextSrcIdx, nextDstIdx) <- f' src srcI srcIdx dst' dstIdx+                         fill (srcI + Offset 1) nextSrcIdx nextDstIdx f' dst'++-- | Length of a String using CountOf+--+-- this size is available in o(n)+length :: String -> CountOf Char+length (String arr)+    | start == end = 0+    | otherwise    = C.onBackend goVec (\_ -> pure . goAddr) arr+  where+    (C.ValidRange !start !end) = offsetsValidRange arr+    goVec ma = UTF8.length ma start end+    goAddr ptr = UTF8.length ptr start end++-- | Replicate a character @c@ @n@ times to create a string of length @n@+replicate :: CountOf Char -> Char -> String+replicate (CountOf n) c = runST (new nbBytes >>= fill)+  where+    nbBytes   = scale (cast n :: Word) sz+    sz = charToBytes (fromEnum c)+    fill :: PrimMonad prim => MutableString (PrimState prim) -> prim String+    fill ms = loop (Offset 0)+      where+        loop idx+            | idx .==# nbBytes = freeze ms+            | otherwise        = write ms idx c >>= loop++-- | Copy the String+--+-- The slice of memory is copied to a new slice, making the new string+-- independent from the original string..+copy :: String -> String+copy (String s) = String (Vec.copy s)++-- | Create a single element String+singleton :: Char -> String+singleton c = runST $ do+    ms <- new nbBytes+    _  <- write ms (Offset 0) c+    freeze ms+  where+    !nbBytes = charToBytes (fromEnum c)++-- | Unsafely create a string of up to @sz@ bytes.+--+-- The callback @f@ needs to return the number of bytes filled in the underlaying+-- bytes buffer. No check is made on the callback return values, and if it's not+-- contained without the bounds, bad things will happen.+create :: PrimMonad prim => CountOf Word8 -> (MutableString (PrimState prim) -> prim (Offset Word8)) -> prim String+create sz f = do+    ms     <- new sz+    filled <- f ms+    if filled .==# sz+        then freeze ms+        else do+            s <- freeze ms+            let (String ba) = s+            pure $ String $ C.take (offsetAsSize filled) ba++-- | Monomorphically map the character in a string and return the transformed one+charMap :: (Char -> Char) -> String -> String+charMap f src+    | srcSz == 0 = mempty+    | otherwise  =+        let !(elems, nbBytes) = allocateAndFill [] (Offset 0) (CountOf 0)+         in runST $ do+                dest <- new nbBytes+                copyLoop dest elems (Offset 0 `offsetPlusE` nbBytes)+                freeze dest+  where+    !srcSz = size src+    srcEnd = azero `offsetPlusE` srcSz++    allocateAndFill :: [(String, CountOf Word8)]+                    -> Offset8+                    -> CountOf Word8+                    -> ([(String,CountOf Word8)], CountOf Word8)+    allocateAndFill acc idx bytesWritten+        | idx == srcEnd = (acc, bytesWritten)+        | otherwise     =+            let (el@(_,addBytes), idx') = runST $ do+                    -- make sure we allocate at least 4 bytes for the destination for the last few bytes+                    -- otherwise allocating less would bring the danger of spinning endlessly+                    -- and never succeeding.+                    let !diffBytes = srcEnd - idx+                        !allocatedBytes = if diffBytes <= CountOf 4 then CountOf 4 else diffBytes+                    ms <- new allocatedBytes+                    (dstIdx, srcIdx) <- fill ms allocatedBytes idx+                    s <- freeze ms+                    return ((s, dstIdx), srcIdx)+             in allocateAndFill (el : acc) idx' (bytesWritten + addBytes)++    fill :: PrimMonad prim+         => MutableString (PrimState prim)+         -> CountOf Word8+         -> Offset8+         -> prim (CountOf Word8, Offset8)+    fill mba dsz srcIdxOrig =+        loop (Offset 0) srcIdxOrig+      where+        endDst = (Offset 0) `offsetPlusE` dsz+        loop dstIdx srcIdx+            | srcIdx == srcEnd = return (offsetAsSize dstIdx, srcIdx)+            | dstIdx == endDst = return (offsetAsSize dstIdx, srcIdx)+            | otherwise        =+                let !(Step c srcIdx') = next src srcIdx+                    c' = f c -- the mapped char+                    !nbBytes = charToBytes (fromEnum c')+                 in -- check if we have room in the destination buffer+                    if dstIdx `offsetPlusE` nbBytes <= sizeAsOffset dsz+                        then do dstIdx' <- write mba dstIdx c'+                                loop dstIdx' srcIdx'+                        else return (offsetAsSize dstIdx, srcIdx)++    copyLoop _   []     (Offset 0) = return ()+    copyLoop _   []     n          = error ("charMap invalid: " <> show n)+    copyLoop ms@(MutableString mba) ((String ba, sz):xs) end = do+        let start = end `offsetMinusE` sz+        Vec.unsafeCopyAtRO mba start ba (Offset 0) sz+        copyLoop ms xs start++-- | Append a Char to the end of the String and return this new String+snoc :: String -> Char -> String+snoc s@(String ba) c+    | len == CountOf 0 = singleton c+    | otherwise     = runST $ do+        ms <- new (len + nbBytes)+        let (MutableString mba) = ms+        Vec.unsafeCopyAtRO mba (Offset 0) ba (Offset 0) len+        _ <- write ms (azero `offsetPlusE` len) c+        freeze ms+  where+    !len     = size s+    !nbBytes = charToBytes (fromEnum c)++-- | Prepend a Char to the beginning of the String and return this new String+cons :: Char -> String -> String+cons c s@(String ba)+  | len == CountOf 0 = singleton c+  | otherwise     = runST $ do+      ms <- new (len + nbBytes)+      let (MutableString mba) = ms+      idx <- write ms (Offset 0) c+      Vec.unsafeCopyAtRO mba idx ba (Offset 0) len+      freeze ms+  where+    !len     = size s+    !nbBytes = charToBytes (fromEnum c)++-- | Extract the String stripped of the last character and the last character if not empty+--+-- If empty, Nothing is returned+unsnoc :: String -> Maybe (String, Char)+unsnoc s@(String arr)+    | sz == 0   = Nothing+    | otherwise =+        let !(StepBack c idx) = prev s (sizeAsOffset sz)+         in Just (String $ Vec.take (offsetAsSize idx) arr, c)+  where+    sz = size s++-- | Extract the First character of a string, and the String stripped of the first character.+--+-- If empty, Nothing is returned+uncons :: String -> Maybe (Char, String)+uncons s@(String ba)+    | null s    = Nothing+    | otherwise =+        let !(Step c idx) = next s azero+         in Just (c, String $ Vec.drop (offsetAsSize idx) ba)++-- | Look for a predicate in the String and return the matched character, if any.+find :: (Char -> Bool) -> String -> Maybe Char+find predicate s = loop (Offset 0)+  where+    !sz = size s+    end = Offset 0 `offsetPlusE` sz+    loop idx+        | idx == end = Nothing+        | otherwise =+            let !(Step c idx') = next s idx+             in case predicate c of+                    True  -> Just c+                    False -> loop idx'++-- | Sort the character in a String using a specific sort function+--+-- TODO: optimise not going through a list+sortBy :: (Char -> Char -> Ordering) -> String -> String+sortBy sortF s = fromList $ Data.List.sortBy sortF $ toList s -- FIXME for tests++-- | Filter characters of a string using the predicate+filter :: (Char -> Bool) -> String -> String+filter predicate (String arr) = runST $ do+    (finalSize, dst) <- newNative sz $ \(MutableBlock mba) ->+        C.onBackendPrim (\ba@(Block !_) -> Alg.copyFilter predicate sz mba ba start)+                        (\fptr -> withFinalPtr fptr $ \ptr@(Ptr !_) -> Alg.copyFilter predicate sz mba ptr start)+                        arr+    freezeShrink finalSize dst+  where+    !sz    = C.length arr+    !start = C.offset arr++-- | Reverse a string+reverse :: String -> String+reverse (String arr) = runST $ do+    s <- newNative_ (C.length arr) $ \(MutableBlock mba) ->+            C.onBackendPrim+                (\ba@(Block !_) -> UTF8.reverse mba 0 ba start end)+                (\fptr -> withFinalPtr fptr $ \ptr@(Ptr !_) -> UTF8.reverse mba 0 ptr start end)+                arr+    freeze s+  where+    !(C.ValidRange start end) = C.offsetsValidRange arr++-- | Finds where are the insertion points when we search for a `needle`+-- within an `haystack`.+indices :: String -> String -> [Offset8]+indices (String ned) (String hy) = Vec.indices ned hy++-- | Replace all the occurrencies of `needle` with `replacement` in+-- the `haystack` string.+replace :: String -> String -> String -> String+replace (String needle) (String replacement) (String haystack) =+  String $ Vec.replace needle replacement haystack++-- | Return the nth character in a String+--+-- Compared to an array, the string need to be scanned from the beginning+-- since the UTF8 encoding is variable.+index :: String -> Offset Char -> Maybe Char+index s n+    | ofs >= end = Nothing+    | otherwise  =+        let (Step !c _) = next s ofs+         in Just c+  where+    !nbBytes = size s+    end = 0 `offsetPlusE` nbBytes+    ofs = indexN (offsetAsSize n) s++-- | Return the index in unit of Char of the first occurence of the predicate returning True+--+-- If not found, Nothing is returned+findIndex :: (Char -> Bool) -> String -> Maybe (Offset Char)+findIndex predicate s = loop 0 0+  where+    !sz = size s+    loop ofs idx+        | idx .==# sz = Nothing+        | otherwise   =+            let !(Step c idx') = next s idx+             in case predicate c of+                    True  -> Just ofs+                    False -> loop (ofs+1) idx'++-- | Various String Encoding that can be use to convert to and from bytes+data Encoding+    = ASCII7+    | UTF8+    | UTF16+    | UTF32+    | ISO_8859_1+    deriving (Typeable, Data, Eq, Ord, Show, Enum, Bounded)++fromEncoderBytes :: ( Encoder.Encoding encoding+                    , PrimType (Encoder.Unit encoding)+                    )+                 => encoding+                 -> UArray Word8+                 -> (String, Maybe ValidationFailure, UArray Word8)+fromEncoderBytes enc bytes =+    case runST $ Encoder.convertFromTo enc EncoderUTF8 (Vec.recast bytes) of+        -- TODO: Don't swallow up specific error (second element of pair)+        -- TODO: Confused why all this recasting is necessary. I "typed hole"-ed my way to get this function to compile.  Feels like there should be a cleaner method.+        Left (off, _) ->+            let (b1, b2) = Vec.splitAt (offsetAsSize off) (Vec.recast bytes)+            in (String $ Vec.recast b1, Just BuildingFailure, Vec.recast b2)+        Right converted -> (String converted, Nothing, mempty)++-- | Convert a ByteArray to a string assuming a specific encoding.+--+-- It returns a 3-tuple of:+--+-- * The string that has been succesfully converted without any error+-- * An optional validation error+-- * The remaining buffer that hasn't been processed (either as a result of an error, or because the encoded sequence is not fully available)+--+-- Considering a stream of data that is fetched chunk by chunk, it's valid to assume+-- that some sequence might fall in a chunk boundary. When converting chunks,+-- if the error is Nothing and the remaining buffer is not empty, then this buffer+-- need to be prepended to the next chunk+fromBytes :: Encoding -> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)+fromBytes ASCII7     bytes = fromEncoderBytes Encoder.ASCII7     bytes+fromBytes ISO_8859_1 bytes = fromEncoderBytes Encoder.ISO_8859_1 bytes+fromBytes UTF16      bytes = fromEncoderBytes Encoder.UTF16      bytes+fromBytes UTF32      bytes = fromEncoderBytes Encoder.UTF32      bytes+fromBytes UTF8       bytes+    | C.null bytes = (mempty, Nothing, mempty)+    | otherwise    =+        case validate bytes (Offset 0) (C.length bytes) of+            (_, Nothing)  -> (fromBytesUnsafe bytes, Nothing, mempty)+            (pos, Just vf) ->+                let (b1, b2) = C.splitAt (offsetAsSize pos) bytes+                 in (fromBytesUnsafe b1, toErr vf, b2)+  where+    toErr MissingByte         = Nothing+    toErr InvalidHeader       = Just InvalidHeader+    toErr InvalidContinuation = Just InvalidContinuation+    toErr BuildingFailure     = Just BuildingFailure++-- | Convert a UTF8 array of bytes to a String.+--+-- If there's any error in the stream, it will automatically+-- insert replacement bytes to replace invalid sequences.+--+-- In the case of sequence that fall in the middle of 2 chunks,+-- the remaining buffer is supposed to be preprended to the+-- next chunk, and resume the parsing.+fromBytesLenient :: UArray Word8 -> (String, UArray Word8)+fromBytesLenient bytes+    | C.null bytes = (mempty, mempty)+    | otherwise    =+        case validate bytes (Offset 0) (C.length bytes) of+            (_, Nothing)                   -> (fromBytesUnsafe bytes, mempty)+            -- TODO: Should anything be done in the 'BuildingFailure' case?+            (_, Just BuildingFailure) -> error "fromBytesLenient: FIXME!"+            (pos, Just MissingByte) ->+                let (b1,b2) = C.splitAt (offsetAsSize pos) bytes+                 in (fromBytesUnsafe b1, b2)+            (pos, Just InvalidHeader) ->+                let (b1,b2) = C.splitAt (offsetAsSize pos) bytes+                    (_,b3)  = C.splitAt 1 b2+                    (s3, r) = fromBytesLenient b3+                 in (mconcat [fromBytesUnsafe b1,replacement, s3], r)+            (pos, Just InvalidContinuation) ->+                let (b1,b2) = C.splitAt (offsetAsSize pos) bytes+                    (_,b3)  = C.splitAt 1 b2+                    (s3, r) = fromBytesLenient b3+                 in (mconcat [fromBytesUnsafe b1,replacement, s3], r)+  where+    -- This is the replacement character U+FFFD used for any invalid header or continuation+    replacement :: String+    !replacement = fromBytesUnsafe $ fromList [0xef,0xbf,0xbd]++-- | Decode a stream of binary chunks containing UTF8 encoding in a list of valid String+--+-- Chunk not necessarily contains a valid string, as+-- a UTF8 sequence could be split over 2 chunks.+fromChunkBytes :: [UArray Word8] -> [String]+fromChunkBytes l = loop l+  where+    loop []         = []+    loop [bytes]    =+        case validate bytes (Offset 0) (C.length bytes) of+            (_, Nothing)  -> [fromBytesUnsafe bytes]+            (_, Just err) -> doErr err+    loop (bytes:cs@(c1:c2)) =+        case validate bytes (Offset 0) (C.length bytes) of+            (_, Nothing) -> fromBytesUnsafe bytes : loop cs+            (pos, Just MissingByte) ->+                let (b1,b2) = C.splitAt (offsetAsSize pos) bytes+                 in fromBytesUnsafe b1 : loop ((b2 `mappend` c1) : c2)+            (_, Just err) -> doErr err+    doErr err = error ("fromChunkBytes: " <> show err)++-- | Convert a Byte Array representing UTF8 data directly to a string without checking for UTF8 validity+--+-- If the input contains invalid sequences, it will trigger runtime async errors when processing data.+--+-- In doubt, use 'fromBytes'+fromBytesUnsafe :: UArray Word8 -> String+fromBytesUnsafe = String++toEncoderBytes :: ( Encoder.Encoding encoding+                  , PrimType (Encoder.Unit encoding)+                  , Exception (Encoder.Error encoding)+                  )+               => encoding+               -> UArray Word8+               -> UArray Word8+toEncoderBytes enc bytes = Vec.recast $+  case runST $ Encoder.convertFromTo EncoderUTF8 enc bytes of+    Left _ -> error "toEncoderBytes: FIXME!"+    Right converted -> converted++-- | Convert a String to a bytearray in a specific encoding+--+-- if the encoding is UTF8, the underlying buffer is returned without extra allocation or any processing+--+-- In any other encoding, some allocation and processing are done to convert.+toBytes :: Encoding -> String -> UArray Word8+toBytes UTF8       (String bytes) = bytes+toBytes ASCII7     (String bytes) = toEncoderBytes Encoder.ASCII7     bytes+toBytes ISO_8859_1 (String bytes) = toEncoderBytes Encoder.ISO_8859_1 bytes+toBytes UTF16      (String bytes) = toEncoderBytes Encoder.UTF16      bytes+toBytes UTF32      (String bytes) = toEncoderBytes Encoder.UTF32      bytes++-- | Split lines in a string using newline as separation.+--+-- Note that carriage return preceding a newline are also strip for+-- maximum compatibility between Windows and Unix system.+lines :: String -> [String]+lines s =+    case breakLine s of+        Left _         -> [s]+        Right (line,r) -> line : lines r++-- | Split words in a string using spaces as separation+--+-- > words "Hello Foundation"+-- [ "Hello", "Foundation" ]+words :: String -> [String]+words = fmap fromList . Prelude.words . toList++-- | Append a character to a String builder+builderAppend :: PrimMonad state => Char -> Builder String MutableString Word8 state err ()+builderAppend c = Builder $ State $ \(i, st, e) ->+    if offsetAsSize i + nbBytes >= chunkSize st+        then do+            cur      <- unsafeFreezeShrink (curChunk st) (offsetAsSize i)+            newChunk <- new (chunkSize st)+            writeUTF8Char newChunk (Offset 0) utf8Char+            return ((), (sizeAsOffset nbBytes, st { prevChunks     = cur : prevChunks st+                                                  , prevChunksSize = offsetAsSize i + prevChunksSize st+                                                  , curChunk       = newChunk+                                                  }, e))+        else do+            writeUTF8Char (curChunk st) i utf8Char+            return ((), (i + sizeAsOffset nbBytes, st, e))+  where+    utf8Char = asUTF8Char c+    nbBytes  = numBytes utf8Char++-- | Create a new String builder using chunks of @sizeChunksI@+builderBuild :: PrimMonad m => Int -> Builder String MutableString Word8 m err () -> m (Either err String)+builderBuild sizeChunksI sb+    | sizeChunksI <= 3 = builderBuild 64 sb+    | otherwise        = do+        firstChunk <- new sizeChunks+        (i, st, e) <- snd <$> runState (runBuilder sb) (Offset 0, BuildingState [] (CountOf 0) firstChunk sizeChunks, Nothing)+        case e of+          Just err -> return (Left err)+          Nothing -> do+            cur <- unsafeFreezeShrink (curChunk st) (offsetAsSize i)+            -- Build final array+            let totalSize = prevChunksSize st + offsetAsSize i+            final <- Vec.new totalSize >>= fillFromEnd totalSize (cur : prevChunks st) >>= Vec.unsafeFreeze+            return . Right . String $ final+  where+    sizeChunks = CountOf sizeChunksI++    fillFromEnd _    []            mba = return mba+    fillFromEnd !end (String x:xs) mba = do+        let sz = Vec.length x+        let start = end `sizeSub` sz+        Vec.unsafeCopyAtRO mba (sizeAsOffset start) x (Offset 0) sz+        fillFromEnd start xs mba++builderBuild_ :: PrimMonad m => Int -> Builder String MutableString Word8 m () () -> m String+builderBuild_ sizeChunksI sb = either (\() -> internalError "impossible output") id <$> builderBuild sizeChunksI sb++stringDewrap :: (Block Word8 -> Offset Word8 -> a)+             -> (Ptr Word8 -> Offset Word8 -> ST s a)+             -> String+             -> a+stringDewrap withBa withPtr (String ba) = C.unsafeDewrap withBa withPtr ba+{-# INLINE stringDewrap #-}++-- | Read an Integer from a String+--+-- Consume an optional minus sign and many digits until end of string.+readIntegral :: (HasNegation i, IntegralUpsize Word8 i, Additive i, Multiplicative i, IsIntegral i) => String -> Maybe i+readIntegral str+    | sz == 0   = Nothing+    | otherwise = stringDewrap withBa (\ptr@(Ptr !_) -> pure . withPtr ptr) str+  where+    !sz = size str+    withBa ba ofs =+        let negativeSign = UTF8.expectAscii ba ofs 0x2d+            startOfs     = if negativeSign then succ ofs else ofs+         in case decimalDigitsBA 0 ba endOfs startOfs of+                (# acc, True, endOfs' #) | endOfs' > startOfs -> Just $! if negativeSign then negate acc else acc+                _                                             -> Nothing+      where !endOfs = ofs `offsetPlusE` sz+    withPtr addr ofs =+        let negativeSign = UTF8.expectAscii addr ofs 0x2d+            startOfs     = if negativeSign then succ ofs else ofs+         in case decimalDigitsPtr 0 addr endOfs startOfs of+                (# acc, True, endOfs' #) | endOfs' > startOfs -> Just $! if negativeSign then negate acc else acc+                _                                             -> Nothing+      where !endOfs = ofs `offsetPlusE` sz+{-# SPECIALISE readIntegral :: String -> Maybe Integer #-}+{-# SPECIALISE readIntegral :: String -> Maybe Int #-}++readInteger :: String -> Maybe Integer+readInteger = readIntegral++-- | Read a Natural from a String+--+-- Consume many digits until end of string.+readNatural :: String -> Maybe Natural+readNatural str+    | sz == 0   = Nothing+    | otherwise = stringDewrap withBa (\ptr@(Ptr !_) -> pure . withPtr ptr) str+  where+    !sz = size str+    withBa ba stringStart =+        case decimalDigitsBA 0 ba eofs stringStart of+            (# acc, True, endOfs #) | endOfs > stringStart -> Just acc+            _                                              -> Nothing+      where eofs = stringStart `offsetPlusE` sz+    withPtr addr stringStart =+        case decimalDigitsPtr 0 addr eofs stringStart of+            (# acc, True, endOfs #) | endOfs > stringStart -> Just acc+            _                                              -> Nothing+      where eofs = stringStart `offsetPlusE` sz++-- | Try to read a Double+readDouble :: String -> Maybe Double+readDouble s =+    readFloatingExact s $ \isNegative integral floatingDigits mExponant ->+        Just $ applySign isNegative $ case (floatingDigits, mExponant) of+            (0, Nothing)              ->                         naturalToDouble integral+            (0, Just exponent)        -> withExponant exponent $ naturalToDouble integral+            (floating, Nothing)       ->                         applyFloating floating $ naturalToDouble integral+            (floating, Just exponent) -> withExponant exponent $ applyFloating floating $ naturalToDouble integral+  where+    applySign True = negate+    applySign False = id+    withExponant e v = v * doubleExponant 10 e+    applyFloating digits n = n / (10 Prelude.^ digits)++-- | Try to read a floating number as a Rational+--+-- Note that for safety reason, only exponent between -10000 and 10000 is allowed+-- as otherwise DoS/OOM is very likely. if you don't want this behavior,+-- switching to a scientific type (not provided yet) that represent the+-- exponent separately is the advised solution.+readRational :: String -> Maybe Prelude.Rational+readRational s =+    readFloatingExact s $ \isNegative integral floatingDigits mExponant ->+        case mExponant of+            Just exponent+                | exponent < -10000 || exponent > 10000 -> Nothing+                | otherwise                             -> Just $ modF isNegative integral % (10 Prelude.^ (cast floatingDigits - exponent))+            Nothing                                     -> Just $ modF isNegative integral % (10 Prelude.^ floatingDigits)+  where+    modF True  = negate . integralUpsize+    modF False = integralUpsize+++type ReadFloatingCallback a = Bool      -- sign+                           -> Natural   -- integral part+                           -> Word      -- number of digits in floating section+                           -> Maybe Int -- optional integer representing exponent in base 10+                           -> Maybe a++-- | Read an Floating like number of the form:+--+--   [ '-' ] <numbers> [ '.' <numbers> ] [ ( 'e' | 'E' ) [ '-' ] <number> ]+--+-- Call a function with:+--+-- * A boolean representing if the number is negative+-- * The digits part represented as a single natural number (123.456 is represented as 123456)+-- * The number of digits in the fractional part (e.g. 123.456 => 3)+-- * The exponent if any+--+-- The code is structured as a simple state machine that:+--+-- * Optionally Consume a '-' sign+-- * Consume number for the integral part+-- * Optionally+--   * Consume '.'+--   * Consume remaining digits if not already end of string+-- * Optionally Consume a 'e' or 'E' follow by an optional '-' and a number+--+readFloatingExact :: String -> ReadFloatingCallback a -> Maybe a+readFloatingExact str f+    | sz == 0   = Nothing+    | otherwise = stringDewrap withBa withPtr str+  where+    !sz = size str++    withBa ba stringStart =+        let !isNegative = UTF8.expectAscii ba stringStart 0x2d+         in consumeIntegral isNegative (if isNegative then stringStart+1 else stringStart)+      where+        eofs = stringStart `offsetPlusE` sz+        consumeIntegral !isNegative startOfs =+            case decimalDigitsBA 0 ba eofs startOfs of+                (# acc, True , endOfs #) | endOfs > startOfs -> f isNegative acc 0 Nothing -- end of stream and no '.'+                (# acc, False, endOfs #) | endOfs > startOfs ->+                    if UTF8.expectAscii ba endOfs 0x2e+                        then consumeFloat isNegative acc (endOfs + 1)+                        else consumeExponant isNegative acc 0 endOfs+                _                                            -> Nothing++        consumeFloat isNegative integral startOfs =+            case decimalDigitsBA integral ba eofs startOfs of+                (# acc, True, endOfs #) | endOfs > startOfs -> let (CountOf !diff) = endOfs - startOfs+                                                                in f isNegative acc (cast diff) Nothing+                (# acc, False, endOfs #) | endOfs > startOfs -> let (CountOf !diff) = endOfs - startOfs+                                                                in consumeExponant isNegative acc (cast diff) endOfs+                _                                           -> Nothing++        consumeExponant !isNegative !integral !floatingDigits !startOfs+            | startOfs == eofs = f isNegative integral floatingDigits Nothing+            | otherwise        =+                -- consume 'E' or 'e'+                case UTF8.nextAscii ba startOfs of+                    StepASCII 0x45 -> consumeExponantSign (startOfs+1)+                    StepASCII 0x65 -> consumeExponantSign (startOfs+1)+                    _              -> Nothing+          where+            consumeExponantSign ofs+                | ofs == eofs = Nothing+                | otherwise   = let exponentNegative = UTF8.expectAscii ba ofs 0x2d+                                 in consumeExponantNumber exponentNegative (if exponentNegative then ofs + 1 else ofs)++            consumeExponantNumber exponentNegative ofs =+                case decimalDigitsBA 0 ba eofs ofs of+                    (# acc, True, endOfs #) | endOfs > ofs -> f isNegative integral floatingDigits (Just $! if exponentNegative then negate acc else acc)+                    _                                      -> Nothing+    withPtr ptr@(Ptr !_) stringStart = pure $+        let !isNegative = UTF8.expectAscii ptr stringStart 0x2d+         in consumeIntegral isNegative (if isNegative then stringStart+1 else stringStart)+      where+        eofs = stringStart `offsetPlusE` sz+        consumeIntegral !isNegative startOfs =+            case decimalDigitsPtr 0 ptr eofs startOfs of+                (# acc, True , endOfs #) | endOfs > startOfs -> f isNegative acc 0 Nothing -- end of stream and no '.'+                (# acc, False, endOfs #) | endOfs > startOfs ->+                    if UTF8.expectAscii ptr endOfs 0x2e+                        then consumeFloat isNegative acc (endOfs + 1)+                        else consumeExponant isNegative acc 0 endOfs+                _                                            -> Nothing++        consumeFloat isNegative integral startOfs =+            case decimalDigitsPtr integral ptr eofs startOfs of+                (# acc, True, endOfs #) | endOfs > startOfs -> let (CountOf !diff) = endOfs - startOfs+                                                                in f isNegative acc (cast diff) Nothing+                (# acc, False, endOfs #) | endOfs > startOfs -> let (CountOf !diff) = endOfs - startOfs+                                                                in consumeExponant isNegative acc (cast diff) endOfs+                _                                           -> Nothing++        consumeExponant !isNegative !integral !floatingDigits !startOfs+            | startOfs == eofs = f isNegative integral floatingDigits Nothing+            | otherwise        =+                -- consume 'E' or 'e'+                case UTF8.nextAscii ptr startOfs of+                    StepASCII 0x45 -> consumeExponantSign (startOfs+1)+                    StepASCII 0x65 -> consumeExponantSign (startOfs+1)+                    _              -> Nothing+          where+            consumeExponantSign ofs+                | ofs == eofs = Nothing+                | otherwise   = let exponentNegative = UTF8.expectAscii ptr ofs 0x2d+                                 in consumeExponantNumber exponentNegative (if exponentNegative then ofs + 1 else ofs)++            consumeExponantNumber exponentNegative ofs =+                case decimalDigitsPtr 0 ptr eofs ofs of+                    (# acc, True, endOfs #) | endOfs > ofs -> f isNegative integral floatingDigits (Just $! if exponentNegative then negate acc else acc)+                    _                                      -> Nothing++-- | Take decimal digits and accumulate it in `acc`+--+-- The loop starts at the offset specified and finish either when:+--+-- * It reach the end of the string+-- * It reach a non-ASCII character+-- * It reach an ASCII character that is not a digit (0 to 9)+--+-- Otherwise each iterations:+--+-- * Transform the ASCII digits into a number+-- * scale the accumulator by 10+-- * Add the number (between 0 and 9) to the accumulator+--+-- It then returns:+--+-- * The new accumulated value+-- * Whether it stop by end of string or not+-- * The end offset when the loop stopped+--+-- If end offset == start offset then no digits have been consumed by+-- this function+decimalDigitsBA :: (IntegralUpsize Word8 acc, Additive acc, Multiplicative acc, Integral acc)+                => acc+                -> Block Word8+                -> Offset Word8 -- end offset+                -> Offset Word8 -- start offset+                -> (# acc, Bool, Offset Word8 #)+decimalDigitsBA startAcc ba !endOfs !startOfs = loop startAcc startOfs+  where+    loop !acc !ofs+        | ofs == endOfs = (# acc, True, ofs #)+        | otherwise     =+            case UTF8.nextAsciiDigit ba ofs of+                sg@(StepDigit d) | isValidStepDigit sg -> loop (10 * acc + integralUpsize d) (succ ofs)+                                 | otherwise           -> (# acc, False, ofs #)+{-# SPECIALIZE decimalDigitsBA :: Integer -> Block Word8 -> Offset Word8 -> Offset Word8 -> (# Integer, Bool, Offset Word8 #) #-}+{-# SPECIALIZE decimalDigitsBA :: Natural -> Block Word8 -> Offset Word8 -> Offset Word8 -> (# Natural, Bool, Offset Word8 #) #-}+{-# SPECIALIZE decimalDigitsBA :: Int -> Block Word8 -> Offset Word8 -> Offset Word8 -> (# Int, Bool, Offset Word8 #) #-}+{-# SPECIALIZE decimalDigitsBA :: Word -> Block Word8 -> Offset Word8 -> Offset Word8 -> (# Word, Bool, Offset Word8 #) #-}++-- | same as decimalDigitsBA specialized for ptr #+decimalDigitsPtr :: (IntegralUpsize Word8 acc, Additive acc, Multiplicative acc, Integral acc)+                 => acc+                 -> Ptr Word8+                 -> Offset Word8 -- end offset+                 -> Offset Word8 -- start offset+                 -> (# acc, Bool, Offset Word8 #)+decimalDigitsPtr startAcc ptr !endOfs !startOfs = loop startAcc startOfs+  where+    loop !acc !ofs+        | ofs == endOfs = (# acc, True, ofs #)+        | otherwise     =+            case UTF8.nextAsciiDigit ptr ofs of+                sg@(StepDigit d) | isValidStepDigit sg -> loop (10 * acc + integralUpsize d) (succ ofs)+                                 | otherwise           -> (# acc, False, ofs #)+{-# SPECIALIZE decimalDigitsPtr :: Integer -> Ptr Word8 -> Offset Word8 -> Offset Word8 -> (# Integer, Bool, Offset Word8 #) #-}+{-# SPECIALIZE decimalDigitsPtr :: Natural -> Ptr Word8 -> Offset Word8 -> Offset Word8 -> (# Natural, Bool, Offset Word8 #) #-}+{-# SPECIALIZE decimalDigitsPtr :: Int -> Ptr Word8 -> Offset Word8 -> Offset Word8 -> (# Int, Bool, Offset Word8 #) #-}+{-# SPECIALIZE decimalDigitsPtr :: Word -> Ptr Word8 -> Offset Word8 -> Offset Word8 -> (# Word, Bool, Offset Word8 #) #-}++-- | Convert a 'String' 'Char' by 'Char' using a case mapping function.+caseConvert :: (Char7 -> Char7) -> (Char -> CM) -> String -> String+caseConvert opASCII op s@(String arr) = runST $ do+  mba <- MBLK.new iLen+  nL <- C.onBackendPrim+        (\blk  -> go mba blk (Offset 0) start)+        (\fptr -> withFinalPtr fptr $ \ptr -> go mba ptr (Offset 0) start)+        arr+  freeze . MutableString $ MVec.MUArray 0 nL (C.MUArrayMBA mba)+  where+    !(C.ValidRange start end) = C.offsetsValidRange arr+    !iLen = 1 + C.length arr+    go :: (Indexable container Word8, PrimMonad prim)+       => MutableBlock Word8 (PrimState prim)+       -> container+       -> Offset Word8+       -> Offset Word8+       -> prim (CountOf Word8)+    go !dst !src = loop dst iLen 0+      where+        eSize !e = if e == '\0' then 0 else charToBytes (fromEnum e)+        loop !dst !allocLen !nLen !dstIdx !srcIdx+          | srcIdx == end    = return nLen+          | nLen == allocLen = realloc+          | headerIsAscii h  = do+                UTF8.writeASCII dst dstIdx (opASCII $ Char7 $ stepAsciiRawValue h)+                loop dst allocLen (nLen + 1) (dstIdx+Offset 1) (srcIdx+Offset 1)+          | otherwise = do+              let !(CM c1 c2 c3) = op c+                  !(Step c nextSrcIdx) = UTF8.nextWith h src (srcIdx+Offset 1)+              nextDstIdx <- UTF8.writeUTF8 dst dstIdx c1+              if c2 == '\0' -- We keep the most common case loop as short as possible.+                then loop dst allocLen (nLen + charToBytes (fromEnum c1)) nextDstIdx nextSrcIdx+                else do+                  let !cSize = eSize c1 + eSize c2 + eSize c3+                  nextDstIdx <- UTF8.writeUTF8 dst nextDstIdx c2+                  nextDstIdx <- if c3 == '\0' then return nextDstIdx else UTF8.writeUTF8 dst nextDstIdx c3+                  loop dst allocLen (nLen + cSize) nextDstIdx nextSrcIdx+          where+            {-# NOINLINE realloc #-}+            realloc = do+              let nAll = allocLen + allocLen + 1+              nDst <- MBLK.new nAll+              MBLK.unsafeCopyElements nDst 0 dst 0 nLen+              loop nDst nAll nLen dstIdx srcIdx+            h = UTF8.nextAscii src srcIdx++-- | Convert a 'String' to the upper-case equivalent.+upper :: String -> String+upper = caseConvert c7Upper upperMapping++-- | Convert a 'String' to the upper-case equivalent.+lower :: String -> String+lower = caseConvert c7Lower lowerMapping++-- | Convert a 'String' to the unicode case fold equivalent.+--+-- Case folding is mostly used for caseless comparison of strings.+caseFold :: String -> String+caseFold = caseConvert c7Upper foldMapping++-- | Check whether the first string is a prefix of the second string.+isPrefixOf :: String -> String -> Bool+isPrefixOf (String needle) (String haystack) = C.isPrefixOf needle haystack++-- | Check whether the first string is a suffix of the second string.+isSuffixOf :: String -> String -> Bool+isSuffixOf (String needle) (String haystack)+    | needleLen > hayLen = False+    | otherwise          = needle == C.revTake needleLen haystack+  where+    needleLen = C.length needle+    hayLen    = C.length haystack++-- | Check whether the first string is contains within the second string.+--+-- TODO: implemented the naive way and thus terribly inefficient, reimplement properly+isInfixOf :: String -> String -> Bool+isInfixOf (String needle) (String haystack)+    = loop (hayLen - needleLen) haystack+    where+      needleLen = C.length needle+      hayLen    = C.length haystack+      loop Nothing    _         = False+      loop (Just cnt) haystack' = needle == C.take needleLen haystack' || loop (cnt-1) (C.drop 1 haystack')++-- | Try to strip a prefix from the start of a String.+--+-- If the prefix is not starting the string, then Nothing is returned,+-- otherwise the striped string is returned+stripPrefix :: String -> String -> Maybe String+stripPrefix (String suffix) (String arr)+    | C.isPrefixOf suffix arr = Just $ String $ C.drop (C.length suffix) arr+    | otherwise               = Nothing++-- | Try to strip a suffix from the end of a String.+--+-- If the suffix is not ending the string, then Nothing is returned,+-- otherwise the striped string is returned+stripSuffix :: String -> String -> Maybe String+stripSuffix (String prefix) (String arr)+    | C.isSuffixOf prefix arr = Just $ String $ C.revDrop (C.length prefix) arr+    | otherwise               = Nothing++all :: (Char -> Bool) -> String -> Bool+all predicate (String arr) = C.onBackend goBA (\_ -> pure . goAddr) arr+  where+    !(C.ValidRange start end) = C.offsetsValidRange arr+    goBA ba   = UTF8.all predicate ba start end+    goAddr addr = UTF8.all predicate addr start end++any :: (Char -> Bool) -> String -> Bool+any predicate (String arr) = C.onBackend goBA (\_ -> pure . goAddr) arr+  where+    !(C.ValidRange start end) = C.offsetsValidRange arr+    goBA ba   = UTF8.any predicate ba start end+    goAddr addr = UTF8.any predicate addr start end++-- | Transform string @src@ to base64 binary representation.+toBase64 :: String -> String+toBase64 (String src) = fromBytesUnsafe . Vec.toBase64Internal set src $ True+  where+    !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"#++-- | Transform string @src@ to URL-safe base64 binary representation.+-- The result will be either padded or unpadded, depending on the boolean+-- @padded@ argument.+toBase64URL :: Bool -> String -> String+toBase64URL padded (String src) = fromBytesUnsafe . Vec.toBase64Internal set src $ padded+  where+    !set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"#++-- | Transform string @src@ to OpenBSD base64 binary representation.+toBase64OpenBSD :: String -> String+toBase64OpenBSD (String src) = fromBytesUnsafe . Vec.toBase64Internal set src $ False+  where+    !set = "./ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"#
+ Basement/String/Builder.hs view
@@ -0,0 +1,58 @@+-- |+-- Module      : Basement.String.Builder+-- License     : BSD-style+-- Maintainer  : Foundation+--+-- String builder++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Basement.String.Builder+    ( Builder+    , run+    , runUnsafe++    -- * Emit functions+    , emit+    , emitChar++    -- * unsafe+    , unsafeStringBuilder+    ) where+++import qualified Basement.Block.Base as Block (length)+import qualified Basement.Block.Builder as Block+import           Basement.Compat.Base+import           Basement.Compat.Semigroup+import           Basement.Monad+import           Basement.String (String, ValidationFailure, Encoding (UTF8), fromBytes)+import           Basement.UArray.Base (UArray)+import qualified Basement.UArray.Base as A++newtype Builder = Builder Block.Builder+  deriving (Semigroup, Monoid)++unsafeStringBuilder :: Block.Builder -> Builder+unsafeStringBuilder = Builder+{-# INLINE unsafeStringBuilder #-}++run :: PrimMonad prim => Builder -> prim (String, Maybe ValidationFailure, UArray Word8)+run (Builder builder) = do+    block <- Block.run builder+    let array = A.UArray 0 (Block.length block) (A.UArrayBA block)+    pure $ fromBytes UTF8 array++-- | run the given builder and return the generated String+--+-- prefer `run`+runUnsafe :: PrimMonad prim => Builder -> prim String+runUnsafe (Builder builder) = Block.unsafeRunString builder++-- | add a string in the builder+emit :: String -> Builder+emit = Builder . Block.emitString++-- | emit a UTF8 char in the builder+emitChar :: Char -> Builder+emitChar = Builder . Block.emitUTF8Char
+ Basement/String/CaseMapping.hs view
@@ -0,0 +1,3240 @@+{-# LANGUAGE Rank2Types #-}+-- AUTOMATICALLY GENERATED - DO NOT EDIT+-- Generated by scripts/caseMapping/generateCaseMapping.sh+-- CaseFolding-10.0.0.txt+-- Date: 2017-04-14, 05:40:18 GMT+-- SpecialCasing-10.0.0.txt+-- Date: 2017-04-14, 05:40:43 GMT++module Basement.String.CaseMapping where++import Data.Char+import Basement.UTF8.Types++upperMapping :: Char -> CM+{-# NOINLINE upperMapping #-}+-- LATIN SMALL LETTER SHARP S+upperMapping '\x00DF' = CM '\x0053' '\x0053' '\0'+-- LATIN SMALL LIGATURE FF+upperMapping '\xFB00' = CM '\x0046' '\x0046' '\0'+-- LATIN SMALL LIGATURE FI+upperMapping '\xFB01' = CM '\x0046' '\x0049' '\0'+-- LATIN SMALL LIGATURE FL+upperMapping '\xFB02' = CM '\x0046' '\x004C' '\0'+-- LATIN SMALL LIGATURE FFI+upperMapping '\xFB03' = CM '\x0046' '\x0046' '\x0049'+-- LATIN SMALL LIGATURE FFL+upperMapping '\xFB04' = CM '\x0046' '\x0046' '\x004C'+-- LATIN SMALL LIGATURE LONG S T+upperMapping '\xFB05' = CM '\x0053' '\x0054' '\0'+-- LATIN SMALL LIGATURE ST+upperMapping '\xFB06' = CM '\x0053' '\x0054' '\0'+-- ARMENIAN SMALL LIGATURE ECH YIWN+upperMapping '\x0587' = CM '\x0535' '\x0552' '\0'+-- ARMENIAN SMALL LIGATURE MEN NOW+upperMapping '\xFB13' = CM '\x0544' '\x0546' '\0'+-- ARMENIAN SMALL LIGATURE MEN ECH+upperMapping '\xFB14' = CM '\x0544' '\x0535' '\0'+-- ARMENIAN SMALL LIGATURE MEN INI+upperMapping '\xFB15' = CM '\x0544' '\x053B' '\0'+-- ARMENIAN SMALL LIGATURE VEW NOW+upperMapping '\xFB16' = CM '\x054E' '\x0546' '\0'+-- ARMENIAN SMALL LIGATURE MEN XEH+upperMapping '\xFB17' = CM '\x0544' '\x053D' '\0'+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+upperMapping '\x0149' = CM '\x02BC' '\x004E' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+upperMapping '\x0390' = CM '\x0399' '\x0308' '\x0301'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+upperMapping '\x03B0' = CM '\x03A5' '\x0308' '\x0301'+-- LATIN SMALL LETTER J WITH CARON+upperMapping '\x01F0' = CM '\x004A' '\x030C' '\0'+-- LATIN SMALL LETTER H WITH LINE BELOW+upperMapping '\x1E96' = CM '\x0048' '\x0331' '\0'+-- LATIN SMALL LETTER T WITH DIAERESIS+upperMapping '\x1E97' = CM '\x0054' '\x0308' '\0'+-- LATIN SMALL LETTER W WITH RING ABOVE+upperMapping '\x1E98' = CM '\x0057' '\x030A' '\0'+-- LATIN SMALL LETTER Y WITH RING ABOVE+upperMapping '\x1E99' = CM '\x0059' '\x030A' '\0'+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+upperMapping '\x1E9A' = CM '\x0041' '\x02BE' '\0'+-- GREEK SMALL LETTER UPSILON WITH PSILI+upperMapping '\x1F50' = CM '\x03A5' '\x0313' '\0'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+upperMapping '\x1F52' = CM '\x03A5' '\x0313' '\x0300'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+upperMapping '\x1F54' = CM '\x03A5' '\x0313' '\x0301'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+upperMapping '\x1F56' = CM '\x03A5' '\x0313' '\x0342'+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+upperMapping '\x1FB6' = CM '\x0391' '\x0342' '\0'+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+upperMapping '\x1FC6' = CM '\x0397' '\x0342' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+upperMapping '\x1FD2' = CM '\x0399' '\x0308' '\x0300'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+upperMapping '\x1FD3' = CM '\x0399' '\x0308' '\x0301'+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+upperMapping '\x1FD6' = CM '\x0399' '\x0342' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1FD7' = CM '\x0399' '\x0308' '\x0342'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+upperMapping '\x1FE2' = CM '\x03A5' '\x0308' '\x0300'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+upperMapping '\x1FE3' = CM '\x03A5' '\x0308' '\x0301'+-- GREEK SMALL LETTER RHO WITH PSILI+upperMapping '\x1FE4' = CM '\x03A1' '\x0313' '\0'+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+upperMapping '\x1FE6' = CM '\x03A5' '\x0342' '\0'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1FE7' = CM '\x03A5' '\x0308' '\x0342'+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+upperMapping '\x1FF6' = CM '\x03A9' '\x0342' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1F80' = CM '\x1F08' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1F81' = CM '\x1F09' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1F82' = CM '\x1F0A' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1F83' = CM '\x1F0B' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1F84' = CM '\x1F0C' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1F85' = CM '\x1F0D' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1F86' = CM '\x1F0E' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1F87' = CM '\x1F0F' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1F88' = CM '\x1F08' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1F89' = CM '\x1F09' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1F8A' = CM '\x1F0A' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1F8B' = CM '\x1F0B' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1F8C' = CM '\x1F0C' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1F8D' = CM '\x1F0D' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1F8E' = CM '\x1F0E' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1F8F' = CM '\x1F0F' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1F90' = CM '\x1F28' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1F91' = CM '\x1F29' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1F92' = CM '\x1F2A' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1F93' = CM '\x1F2B' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1F94' = CM '\x1F2C' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1F95' = CM '\x1F2D' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1F96' = CM '\x1F2E' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1F97' = CM '\x1F2F' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1F98' = CM '\x1F28' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1F99' = CM '\x1F29' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1F9A' = CM '\x1F2A' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1F9B' = CM '\x1F2B' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1F9C' = CM '\x1F2C' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1F9D' = CM '\x1F2D' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1F9E' = CM '\x1F2E' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1F9F' = CM '\x1F2F' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1FA0' = CM '\x1F68' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1FA1' = CM '\x1F69' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1FA2' = CM '\x1F6A' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1FA3' = CM '\x1F6B' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1FA4' = CM '\x1F6C' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1FA5' = CM '\x1F6D' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1FA6' = CM '\x1F6E' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1FA7' = CM '\x1F6F' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1FA8' = CM '\x1F68' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1FA9' = CM '\x1F69' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1FAA' = CM '\x1F6A' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1FAB' = CM '\x1F6B' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1FAC' = CM '\x1F6C' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1FAD' = CM '\x1F6D' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1FAE' = CM '\x1F6E' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1FAF' = CM '\x1F6F' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+upperMapping '\x1FB3' = CM '\x0391' '\x0399' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+upperMapping '\x1FBC' = CM '\x0391' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+upperMapping '\x1FC3' = CM '\x0397' '\x0399' '\0'+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+upperMapping '\x1FCC' = CM '\x0397' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+upperMapping '\x1FF3' = CM '\x03A9' '\x0399' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+upperMapping '\x1FFC' = CM '\x03A9' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1FB2' = CM '\x1FBA' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1FB4' = CM '\x0386' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1FC2' = CM '\x1FCA' '\x0399' '\0'+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1FC4' = CM '\x0389' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1FF2' = CM '\x1FFA' '\x0399' '\0'+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1FF4' = CM '\x038F' '\x0399' '\0'+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1FB7' = CM '\x0391' '\x0342' '\x0399'+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1FC7' = CM '\x0397' '\x0342' '\x0399'+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1FF7' = CM '\x03A9' '\x0342' '\x0399'+upperMapping c = CM (toUpper c) '\0' '\0'++lowerMapping :: Char -> CM+{-# NOINLINE lowerMapping #-}+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+lowerMapping '\x0130' = CM '\x0069' '\x0307' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+lowerMapping '\x1F88' = CM '\x1F80' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+lowerMapping '\x1F89' = CM '\x1F81' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+lowerMapping '\x1F8A' = CM '\x1F82' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+lowerMapping '\x1F8B' = CM '\x1F83' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+lowerMapping '\x1F8C' = CM '\x1F84' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+lowerMapping '\x1F8D' = CM '\x1F85' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+lowerMapping '\x1F8E' = CM '\x1F86' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+lowerMapping '\x1F8F' = CM '\x1F87' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+lowerMapping '\x1F98' = CM '\x1F90' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+lowerMapping '\x1F99' = CM '\x1F91' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+lowerMapping '\x1F9A' = CM '\x1F92' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+lowerMapping '\x1F9B' = CM '\x1F93' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+lowerMapping '\x1F9C' = CM '\x1F94' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+lowerMapping '\x1F9D' = CM '\x1F95' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+lowerMapping '\x1F9E' = CM '\x1F96' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+lowerMapping '\x1F9F' = CM '\x1F97' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+lowerMapping '\x1FA8' = CM '\x1FA0' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+lowerMapping '\x1FA9' = CM '\x1FA1' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+lowerMapping '\x1FAA' = CM '\x1FA2' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+lowerMapping '\x1FAB' = CM '\x1FA3' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+lowerMapping '\x1FAC' = CM '\x1FA4' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+lowerMapping '\x1FAD' = CM '\x1FA5' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+lowerMapping '\x1FAE' = CM '\x1FA6' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+lowerMapping '\x1FAF' = CM '\x1FA7' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+lowerMapping '\x1FBC' = CM '\x1FB3' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+lowerMapping '\x1FCC' = CM '\x1FC3' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+lowerMapping '\x1FFC' = CM '\x1FF3' '\0' '\0'+lowerMapping c = CM (toLower c) '\0' '\0'++titleMapping :: Char -> CM+{-# NOINLINE titleMapping #-}+-- LATIN SMALL LETTER SHARP S+titleMapping '\x00DF' = CM '\x0053' '\x0073' '\0'+-- LATIN SMALL LIGATURE FF+titleMapping '\xFB00' = CM '\x0046' '\x0066' '\0'+-- LATIN SMALL LIGATURE FI+titleMapping '\xFB01' = CM '\x0046' '\x0069' '\0'+-- LATIN SMALL LIGATURE FL+titleMapping '\xFB02' = CM '\x0046' '\x006C' '\0'+-- LATIN SMALL LIGATURE FFI+titleMapping '\xFB03' = CM '\x0046' '\x0066' '\x0069'+-- LATIN SMALL LIGATURE FFL+titleMapping '\xFB04' = CM '\x0046' '\x0066' '\x006C'+-- LATIN SMALL LIGATURE LONG S T+titleMapping '\xFB05' = CM '\x0053' '\x0074' '\0'+-- LATIN SMALL LIGATURE ST+titleMapping '\xFB06' = CM '\x0053' '\x0074' '\0'+-- ARMENIAN SMALL LIGATURE ECH YIWN+titleMapping '\x0587' = CM '\x0535' '\x0582' '\0'+-- ARMENIAN SMALL LIGATURE MEN NOW+titleMapping '\xFB13' = CM '\x0544' '\x0576' '\0'+-- ARMENIAN SMALL LIGATURE MEN ECH+titleMapping '\xFB14' = CM '\x0544' '\x0565' '\0'+-- ARMENIAN SMALL LIGATURE MEN INI+titleMapping '\xFB15' = CM '\x0544' '\x056B' '\0'+-- ARMENIAN SMALL LIGATURE VEW NOW+titleMapping '\xFB16' = CM '\x054E' '\x0576' '\0'+-- ARMENIAN SMALL LIGATURE MEN XEH+titleMapping '\xFB17' = CM '\x0544' '\x056D' '\0'+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+titleMapping '\x0149' = CM '\x02BC' '\x004E' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+titleMapping '\x0390' = CM '\x0399' '\x0308' '\x0301'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+titleMapping '\x03B0' = CM '\x03A5' '\x0308' '\x0301'+-- LATIN SMALL LETTER J WITH CARON+titleMapping '\x01F0' = CM '\x004A' '\x030C' '\0'+-- LATIN SMALL LETTER H WITH LINE BELOW+titleMapping '\x1E96' = CM '\x0048' '\x0331' '\0'+-- LATIN SMALL LETTER T WITH DIAERESIS+titleMapping '\x1E97' = CM '\x0054' '\x0308' '\0'+-- LATIN SMALL LETTER W WITH RING ABOVE+titleMapping '\x1E98' = CM '\x0057' '\x030A' '\0'+-- LATIN SMALL LETTER Y WITH RING ABOVE+titleMapping '\x1E99' = CM '\x0059' '\x030A' '\0'+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+titleMapping '\x1E9A' = CM '\x0041' '\x02BE' '\0'+-- GREEK SMALL LETTER UPSILON WITH PSILI+titleMapping '\x1F50' = CM '\x03A5' '\x0313' '\0'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+titleMapping '\x1F52' = CM '\x03A5' '\x0313' '\x0300'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+titleMapping '\x1F54' = CM '\x03A5' '\x0313' '\x0301'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+titleMapping '\x1F56' = CM '\x03A5' '\x0313' '\x0342'+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+titleMapping '\x1FB6' = CM '\x0391' '\x0342' '\0'+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+titleMapping '\x1FC6' = CM '\x0397' '\x0342' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+titleMapping '\x1FD2' = CM '\x0399' '\x0308' '\x0300'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+titleMapping '\x1FD3' = CM '\x0399' '\x0308' '\x0301'+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+titleMapping '\x1FD6' = CM '\x0399' '\x0342' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1FD7' = CM '\x0399' '\x0308' '\x0342'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+titleMapping '\x1FE2' = CM '\x03A5' '\x0308' '\x0300'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+titleMapping '\x1FE3' = CM '\x03A5' '\x0308' '\x0301'+-- GREEK SMALL LETTER RHO WITH PSILI+titleMapping '\x1FE4' = CM '\x03A1' '\x0313' '\0'+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+titleMapping '\x1FE6' = CM '\x03A5' '\x0342' '\0'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1FE7' = CM '\x03A5' '\x0308' '\x0342'+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+titleMapping '\x1FF6' = CM '\x03A9' '\x0342' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+titleMapping '\x1F80' = CM '\x1F88' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+titleMapping '\x1F81' = CM '\x1F89' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+titleMapping '\x1F82' = CM '\x1F8A' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+titleMapping '\x1F83' = CM '\x1F8B' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+titleMapping '\x1F84' = CM '\x1F8C' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+titleMapping '\x1F85' = CM '\x1F8D' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1F86' = CM '\x1F8E' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1F87' = CM '\x1F8F' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+titleMapping '\x1F90' = CM '\x1F98' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+titleMapping '\x1F91' = CM '\x1F99' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+titleMapping '\x1F92' = CM '\x1F9A' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+titleMapping '\x1F93' = CM '\x1F9B' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+titleMapping '\x1F94' = CM '\x1F9C' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+titleMapping '\x1F95' = CM '\x1F9D' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1F96' = CM '\x1F9E' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1F97' = CM '\x1F9F' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+titleMapping '\x1FA0' = CM '\x1FA8' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+titleMapping '\x1FA1' = CM '\x1FA9' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+titleMapping '\x1FA2' = CM '\x1FAA' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+titleMapping '\x1FA3' = CM '\x1FAB' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+titleMapping '\x1FA4' = CM '\x1FAC' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+titleMapping '\x1FA5' = CM '\x1FAD' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1FA6' = CM '\x1FAE' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1FA7' = CM '\x1FAF' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+titleMapping '\x1FB3' = CM '\x1FBC' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+titleMapping '\x1FC3' = CM '\x1FCC' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+titleMapping '\x1FF3' = CM '\x1FFC' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1FB2' = CM '\x1FBA' '\x0345' '\0'+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1FB4' = CM '\x0386' '\x0345' '\0'+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1FC2' = CM '\x1FCA' '\x0345' '\0'+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1FC4' = CM '\x0389' '\x0345' '\0'+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1FF2' = CM '\x1FFA' '\x0345' '\0'+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1FF4' = CM '\x038F' '\x0345' '\0'+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1FB7' = CM '\x0391' '\x0342' '\x0345'+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1FC7' = CM '\x0397' '\x0342' '\x0345'+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1FF7' = CM '\x03A9' '\x0342' '\x0345'+titleMapping c = CM (toTitle c) '\0' '\0'++foldMapping :: Char -> CM+{-# NOINLINE foldMapping #-}+-- LATIN CAPITAL LETTER A+foldMapping '\x0041' = CM '\x0061' '\0' '\0'+-- LATIN CAPITAL LETTER B+foldMapping '\x0042' = CM '\x0062' '\0' '\0'+-- LATIN CAPITAL LETTER C+foldMapping '\x0043' = CM '\x0063' '\0' '\0'+-- LATIN CAPITAL LETTER D+foldMapping '\x0044' = CM '\x0064' '\0' '\0'+-- LATIN CAPITAL LETTER E+foldMapping '\x0045' = CM '\x0065' '\0' '\0'+-- LATIN CAPITAL LETTER F+foldMapping '\x0046' = CM '\x0066' '\0' '\0'+-- LATIN CAPITAL LETTER G+foldMapping '\x0047' = CM '\x0067' '\0' '\0'+-- LATIN CAPITAL LETTER H+foldMapping '\x0048' = CM '\x0068' '\0' '\0'+-- LATIN CAPITAL LETTER I+foldMapping '\x0049' = CM '\x0069' '\0' '\0'+-- LATIN CAPITAL LETTER J+foldMapping '\x004A' = CM '\x006A' '\0' '\0'+-- LATIN CAPITAL LETTER K+foldMapping '\x004B' = CM '\x006B' '\0' '\0'+-- LATIN CAPITAL LETTER L+foldMapping '\x004C' = CM '\x006C' '\0' '\0'+-- LATIN CAPITAL LETTER M+foldMapping '\x004D' = CM '\x006D' '\0' '\0'+-- LATIN CAPITAL LETTER N+foldMapping '\x004E' = CM '\x006E' '\0' '\0'+-- LATIN CAPITAL LETTER O+foldMapping '\x004F' = CM '\x006F' '\0' '\0'+-- LATIN CAPITAL LETTER P+foldMapping '\x0050' = CM '\x0070' '\0' '\0'+-- LATIN CAPITAL LETTER Q+foldMapping '\x0051' = CM '\x0071' '\0' '\0'+-- LATIN CAPITAL LETTER R+foldMapping '\x0052' = CM '\x0072' '\0' '\0'+-- LATIN CAPITAL LETTER S+foldMapping '\x0053' = CM '\x0073' '\0' '\0'+-- LATIN CAPITAL LETTER T+foldMapping '\x0054' = CM '\x0074' '\0' '\0'+-- LATIN CAPITAL LETTER U+foldMapping '\x0055' = CM '\x0075' '\0' '\0'+-- LATIN CAPITAL LETTER V+foldMapping '\x0056' = CM '\x0076' '\0' '\0'+-- LATIN CAPITAL LETTER W+foldMapping '\x0057' = CM '\x0077' '\0' '\0'+-- LATIN CAPITAL LETTER X+foldMapping '\x0058' = CM '\x0078' '\0' '\0'+-- LATIN CAPITAL LETTER Y+foldMapping '\x0059' = CM '\x0079' '\0' '\0'+-- LATIN CAPITAL LETTER Z+foldMapping '\x005A' = CM '\x007A' '\0' '\0'+-- MICRO SIGN+foldMapping '\x00B5' = CM '\x03BC' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH GRAVE+foldMapping '\x00C0' = CM '\x00E0' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH ACUTE+foldMapping '\x00C1' = CM '\x00E1' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CIRCUMFLEX+foldMapping '\x00C2' = CM '\x00E2' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH TILDE+foldMapping '\x00C3' = CM '\x00E3' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH DIAERESIS+foldMapping '\x00C4' = CM '\x00E4' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH RING ABOVE+foldMapping '\x00C5' = CM '\x00E5' '\0' '\0'+-- LATIN CAPITAL LETTER AE+foldMapping '\x00C6' = CM '\x00E6' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH CEDILLA+foldMapping '\x00C7' = CM '\x00E7' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH GRAVE+foldMapping '\x00C8' = CM '\x00E8' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH ACUTE+foldMapping '\x00C9' = CM '\x00E9' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX+foldMapping '\x00CA' = CM '\x00EA' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH DIAERESIS+foldMapping '\x00CB' = CM '\x00EB' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH GRAVE+foldMapping '\x00CC' = CM '\x00EC' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH ACUTE+foldMapping '\x00CD' = CM '\x00ED' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH CIRCUMFLEX+foldMapping '\x00CE' = CM '\x00EE' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH DIAERESIS+foldMapping '\x00CF' = CM '\x00EF' '\0' '\0'+-- LATIN CAPITAL LETTER ETH+foldMapping '\x00D0' = CM '\x00F0' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH TILDE+foldMapping '\x00D1' = CM '\x00F1' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH GRAVE+foldMapping '\x00D2' = CM '\x00F2' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH ACUTE+foldMapping '\x00D3' = CM '\x00F3' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CIRCUMFLEX+foldMapping '\x00D4' = CM '\x00F4' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH TILDE+foldMapping '\x00D5' = CM '\x00F5' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DIAERESIS+foldMapping '\x00D6' = CM '\x00F6' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH STROKE+foldMapping '\x00D8' = CM '\x00F8' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH GRAVE+foldMapping '\x00D9' = CM '\x00F9' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH ACUTE+foldMapping '\x00DA' = CM '\x00FA' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH CIRCUMFLEX+foldMapping '\x00DB' = CM '\x00FB' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DIAERESIS+foldMapping '\x00DC' = CM '\x00FC' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH ACUTE+foldMapping '\x00DD' = CM '\x00FD' '\0' '\0'+-- LATIN CAPITAL LETTER THORN+foldMapping '\x00DE' = CM '\x00FE' '\0' '\0'+-- LATIN SMALL LETTER SHARP S+foldMapping '\x00DF' = CM '\x0073' '\x0073' '\0'+-- LATIN CAPITAL LETTER A WITH MACRON+foldMapping '\x0100' = CM '\x0101' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH BREVE+foldMapping '\x0102' = CM '\x0103' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH OGONEK+foldMapping '\x0104' = CM '\x0105' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH ACUTE+foldMapping '\x0106' = CM '\x0107' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH CIRCUMFLEX+foldMapping '\x0108' = CM '\x0109' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH DOT ABOVE+foldMapping '\x010A' = CM '\x010B' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH CARON+foldMapping '\x010C' = CM '\x010D' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH CARON+foldMapping '\x010E' = CM '\x010F' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH STROKE+foldMapping '\x0110' = CM '\x0111' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH MACRON+foldMapping '\x0112' = CM '\x0113' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH BREVE+foldMapping '\x0114' = CM '\x0115' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH DOT ABOVE+foldMapping '\x0116' = CM '\x0117' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH OGONEK+foldMapping '\x0118' = CM '\x0119' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CARON+foldMapping '\x011A' = CM '\x011B' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH CIRCUMFLEX+foldMapping '\x011C' = CM '\x011D' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH BREVE+foldMapping '\x011E' = CM '\x011F' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH DOT ABOVE+foldMapping '\x0120' = CM '\x0121' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH CEDILLA+foldMapping '\x0122' = CM '\x0123' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH CIRCUMFLEX+foldMapping '\x0124' = CM '\x0125' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH STROKE+foldMapping '\x0126' = CM '\x0127' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH TILDE+foldMapping '\x0128' = CM '\x0129' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH MACRON+foldMapping '\x012A' = CM '\x012B' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH BREVE+foldMapping '\x012C' = CM '\x012D' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH OGONEK+foldMapping '\x012E' = CM '\x012F' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+foldMapping '\x0130' = CM '\x0069' '\x0307' '\0'+-- LATIN CAPITAL LIGATURE IJ+foldMapping '\x0132' = CM '\x0133' '\0' '\0'+-- LATIN CAPITAL LETTER J WITH CIRCUMFLEX+foldMapping '\x0134' = CM '\x0135' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH CEDILLA+foldMapping '\x0136' = CM '\x0137' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH ACUTE+foldMapping '\x0139' = CM '\x013A' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH CEDILLA+foldMapping '\x013B' = CM '\x013C' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH CARON+foldMapping '\x013D' = CM '\x013E' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH MIDDLE DOT+foldMapping '\x013F' = CM '\x0140' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH STROKE+foldMapping '\x0141' = CM '\x0142' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH ACUTE+foldMapping '\x0143' = CM '\x0144' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH CEDILLA+foldMapping '\x0145' = CM '\x0146' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH CARON+foldMapping '\x0147' = CM '\x0148' '\0' '\0'+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+foldMapping '\x0149' = CM '\x02BC' '\x006E' '\0'+-- LATIN CAPITAL LETTER ENG+foldMapping '\x014A' = CM '\x014B' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH MACRON+foldMapping '\x014C' = CM '\x014D' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH BREVE+foldMapping '\x014E' = CM '\x014F' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DOUBLE ACUTE+foldMapping '\x0150' = CM '\x0151' '\0' '\0'+-- LATIN CAPITAL LIGATURE OE+foldMapping '\x0152' = CM '\x0153' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH ACUTE+foldMapping '\x0154' = CM '\x0155' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH CEDILLA+foldMapping '\x0156' = CM '\x0157' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH CARON+foldMapping '\x0158' = CM '\x0159' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH ACUTE+foldMapping '\x015A' = CM '\x015B' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH CIRCUMFLEX+foldMapping '\x015C' = CM '\x015D' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH CEDILLA+foldMapping '\x015E' = CM '\x015F' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH CARON+foldMapping '\x0160' = CM '\x0161' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH CEDILLA+foldMapping '\x0162' = CM '\x0163' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH CARON+foldMapping '\x0164' = CM '\x0165' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH STROKE+foldMapping '\x0166' = CM '\x0167' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH TILDE+foldMapping '\x0168' = CM '\x0169' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH MACRON+foldMapping '\x016A' = CM '\x016B' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH BREVE+foldMapping '\x016C' = CM '\x016D' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH RING ABOVE+foldMapping '\x016E' = CM '\x016F' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DOUBLE ACUTE+foldMapping '\x0170' = CM '\x0171' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH OGONEK+foldMapping '\x0172' = CM '\x0173' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH CIRCUMFLEX+foldMapping '\x0174' = CM '\x0175' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH CIRCUMFLEX+foldMapping '\x0176' = CM '\x0177' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH DIAERESIS+foldMapping '\x0178' = CM '\x00FF' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH ACUTE+foldMapping '\x0179' = CM '\x017A' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH DOT ABOVE+foldMapping '\x017B' = CM '\x017C' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH CARON+foldMapping '\x017D' = CM '\x017E' '\0' '\0'+-- LATIN SMALL LETTER LONG S+foldMapping '\x017F' = CM '\x0073' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH HOOK+foldMapping '\x0181' = CM '\x0253' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH TOPBAR+foldMapping '\x0182' = CM '\x0183' '\0' '\0'+-- LATIN CAPITAL LETTER TONE SIX+foldMapping '\x0184' = CM '\x0185' '\0' '\0'+-- LATIN CAPITAL LETTER OPEN O+foldMapping '\x0186' = CM '\x0254' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH HOOK+foldMapping '\x0187' = CM '\x0188' '\0' '\0'+-- LATIN CAPITAL LETTER AFRICAN D+foldMapping '\x0189' = CM '\x0256' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH HOOK+foldMapping '\x018A' = CM '\x0257' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH TOPBAR+foldMapping '\x018B' = CM '\x018C' '\0' '\0'+-- LATIN CAPITAL LETTER REVERSED E+foldMapping '\x018E' = CM '\x01DD' '\0' '\0'+-- LATIN CAPITAL LETTER SCHWA+foldMapping '\x018F' = CM '\x0259' '\0' '\0'+-- LATIN CAPITAL LETTER OPEN E+foldMapping '\x0190' = CM '\x025B' '\0' '\0'+-- LATIN CAPITAL LETTER F WITH HOOK+foldMapping '\x0191' = CM '\x0192' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH HOOK+foldMapping '\x0193' = CM '\x0260' '\0' '\0'+-- LATIN CAPITAL LETTER GAMMA+foldMapping '\x0194' = CM '\x0263' '\0' '\0'+-- LATIN CAPITAL LETTER IOTA+foldMapping '\x0196' = CM '\x0269' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH STROKE+foldMapping '\x0197' = CM '\x0268' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH HOOK+foldMapping '\x0198' = CM '\x0199' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED M+foldMapping '\x019C' = CM '\x026F' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH LEFT HOOK+foldMapping '\x019D' = CM '\x0272' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH MIDDLE TILDE+foldMapping '\x019F' = CM '\x0275' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HORN+foldMapping '\x01A0' = CM '\x01A1' '\0' '\0'+-- LATIN CAPITAL LETTER OI+foldMapping '\x01A2' = CM '\x01A3' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH HOOK+foldMapping '\x01A4' = CM '\x01A5' '\0' '\0'+-- LATIN LETTER YR+foldMapping '\x01A6' = CM '\x0280' '\0' '\0'+-- LATIN CAPITAL LETTER TONE TWO+foldMapping '\x01A7' = CM '\x01A8' '\0' '\0'+-- LATIN CAPITAL LETTER ESH+foldMapping '\x01A9' = CM '\x0283' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH HOOK+foldMapping '\x01AC' = CM '\x01AD' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH RETROFLEX HOOK+foldMapping '\x01AE' = CM '\x0288' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HORN+foldMapping '\x01AF' = CM '\x01B0' '\0' '\0'+-- LATIN CAPITAL LETTER UPSILON+foldMapping '\x01B1' = CM '\x028A' '\0' '\0'+-- LATIN CAPITAL LETTER V WITH HOOK+foldMapping '\x01B2' = CM '\x028B' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH HOOK+foldMapping '\x01B3' = CM '\x01B4' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH STROKE+foldMapping '\x01B5' = CM '\x01B6' '\0' '\0'+-- LATIN CAPITAL LETTER EZH+foldMapping '\x01B7' = CM '\x0292' '\0' '\0'+-- LATIN CAPITAL LETTER EZH REVERSED+foldMapping '\x01B8' = CM '\x01B9' '\0' '\0'+-- LATIN CAPITAL LETTER TONE FIVE+foldMapping '\x01BC' = CM '\x01BD' '\0' '\0'+-- LATIN CAPITAL LETTER DZ WITH CARON+foldMapping '\x01C4' = CM '\x01C6' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON+foldMapping '\x01C5' = CM '\x01C6' '\0' '\0'+-- LATIN CAPITAL LETTER LJ+foldMapping '\x01C7' = CM '\x01C9' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH SMALL LETTER J+foldMapping '\x01C8' = CM '\x01C9' '\0' '\0'+-- LATIN CAPITAL LETTER NJ+foldMapping '\x01CA' = CM '\x01CC' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH SMALL LETTER J+foldMapping '\x01CB' = CM '\x01CC' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CARON+foldMapping '\x01CD' = CM '\x01CE' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH CARON+foldMapping '\x01CF' = CM '\x01D0' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CARON+foldMapping '\x01D1' = CM '\x01D2' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH CARON+foldMapping '\x01D3' = CM '\x01D4' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DIAERESIS AND MACRON+foldMapping '\x01D5' = CM '\x01D6' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DIAERESIS AND ACUTE+foldMapping '\x01D7' = CM '\x01D8' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DIAERESIS AND CARON+foldMapping '\x01D9' = CM '\x01DA' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DIAERESIS AND GRAVE+foldMapping '\x01DB' = CM '\x01DC' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON+foldMapping '\x01DE' = CM '\x01DF' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON+foldMapping '\x01E0' = CM '\x01E1' '\0' '\0'+-- LATIN CAPITAL LETTER AE WITH MACRON+foldMapping '\x01E2' = CM '\x01E3' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH STROKE+foldMapping '\x01E4' = CM '\x01E5' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH CARON+foldMapping '\x01E6' = CM '\x01E7' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH CARON+foldMapping '\x01E8' = CM '\x01E9' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH OGONEK+foldMapping '\x01EA' = CM '\x01EB' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH OGONEK AND MACRON+foldMapping '\x01EC' = CM '\x01ED' '\0' '\0'+-- LATIN CAPITAL LETTER EZH WITH CARON+foldMapping '\x01EE' = CM '\x01EF' '\0' '\0'+-- LATIN SMALL LETTER J WITH CARON+foldMapping '\x01F0' = CM '\x006A' '\x030C' '\0'+-- LATIN CAPITAL LETTER DZ+foldMapping '\x01F1' = CM '\x01F3' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH SMALL LETTER Z+foldMapping '\x01F2' = CM '\x01F3' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH ACUTE+foldMapping '\x01F4' = CM '\x01F5' '\0' '\0'+-- LATIN CAPITAL LETTER HWAIR+foldMapping '\x01F6' = CM '\x0195' '\0' '\0'+-- LATIN CAPITAL LETTER WYNN+foldMapping '\x01F7' = CM '\x01BF' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH GRAVE+foldMapping '\x01F8' = CM '\x01F9' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE+foldMapping '\x01FA' = CM '\x01FB' '\0' '\0'+-- LATIN CAPITAL LETTER AE WITH ACUTE+foldMapping '\x01FC' = CM '\x01FD' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH STROKE AND ACUTE+foldMapping '\x01FE' = CM '\x01FF' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH DOUBLE GRAVE+foldMapping '\x0200' = CM '\x0201' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH INVERTED BREVE+foldMapping '\x0202' = CM '\x0203' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH DOUBLE GRAVE+foldMapping '\x0204' = CM '\x0205' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH INVERTED BREVE+foldMapping '\x0206' = CM '\x0207' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH DOUBLE GRAVE+foldMapping '\x0208' = CM '\x0209' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH INVERTED BREVE+foldMapping '\x020A' = CM '\x020B' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DOUBLE GRAVE+foldMapping '\x020C' = CM '\x020D' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH INVERTED BREVE+foldMapping '\x020E' = CM '\x020F' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH DOUBLE GRAVE+foldMapping '\x0210' = CM '\x0211' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH INVERTED BREVE+foldMapping '\x0212' = CM '\x0213' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DOUBLE GRAVE+foldMapping '\x0214' = CM '\x0215' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH INVERTED BREVE+foldMapping '\x0216' = CM '\x0217' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH COMMA BELOW+foldMapping '\x0218' = CM '\x0219' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH COMMA BELOW+foldMapping '\x021A' = CM '\x021B' '\0' '\0'+-- LATIN CAPITAL LETTER YOGH+foldMapping '\x021C' = CM '\x021D' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH CARON+foldMapping '\x021E' = CM '\x021F' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH LONG RIGHT LEG+foldMapping '\x0220' = CM '\x019E' '\0' '\0'+-- LATIN CAPITAL LETTER OU+foldMapping '\x0222' = CM '\x0223' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH HOOK+foldMapping '\x0224' = CM '\x0225' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH DOT ABOVE+foldMapping '\x0226' = CM '\x0227' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CEDILLA+foldMapping '\x0228' = CM '\x0229' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DIAERESIS AND MACRON+foldMapping '\x022A' = CM '\x022B' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH TILDE AND MACRON+foldMapping '\x022C' = CM '\x022D' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DOT ABOVE+foldMapping '\x022E' = CM '\x022F' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DOT ABOVE AND MACRON+foldMapping '\x0230' = CM '\x0231' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH MACRON+foldMapping '\x0232' = CM '\x0233' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH STROKE+foldMapping '\x023A' = CM '\x2C65' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH STROKE+foldMapping '\x023B' = CM '\x023C' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH BAR+foldMapping '\x023D' = CM '\x019A' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH DIAGONAL STROKE+foldMapping '\x023E' = CM '\x2C66' '\0' '\0'+-- LATIN CAPITAL LETTER GLOTTAL STOP+foldMapping '\x0241' = CM '\x0242' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH STROKE+foldMapping '\x0243' = CM '\x0180' '\0' '\0'+-- LATIN CAPITAL LETTER U BAR+foldMapping '\x0244' = CM '\x0289' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED V+foldMapping '\x0245' = CM '\x028C' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH STROKE+foldMapping '\x0246' = CM '\x0247' '\0' '\0'+-- LATIN CAPITAL LETTER J WITH STROKE+foldMapping '\x0248' = CM '\x0249' '\0' '\0'+-- LATIN CAPITAL LETTER SMALL Q WITH HOOK TAIL+foldMapping '\x024A' = CM '\x024B' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH STROKE+foldMapping '\x024C' = CM '\x024D' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH STROKE+foldMapping '\x024E' = CM '\x024F' '\0' '\0'+-- COMBINING GREEK YPOGEGRAMMENI+foldMapping '\x0345' = CM '\x03B9' '\0' '\0'+-- GREEK CAPITAL LETTER HETA+foldMapping '\x0370' = CM '\x0371' '\0' '\0'+-- GREEK CAPITAL LETTER ARCHAIC SAMPI+foldMapping '\x0372' = CM '\x0373' '\0' '\0'+-- GREEK CAPITAL LETTER PAMPHYLIAN DIGAMMA+foldMapping '\x0376' = CM '\x0377' '\0' '\0'+-- GREEK CAPITAL LETTER YOT+foldMapping '\x037F' = CM '\x03F3' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH TONOS+foldMapping '\x0386' = CM '\x03AC' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH TONOS+foldMapping '\x0388' = CM '\x03AD' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH TONOS+foldMapping '\x0389' = CM '\x03AE' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH TONOS+foldMapping '\x038A' = CM '\x03AF' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH TONOS+foldMapping '\x038C' = CM '\x03CC' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH TONOS+foldMapping '\x038E' = CM '\x03CD' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH TONOS+foldMapping '\x038F' = CM '\x03CE' '\0' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+foldMapping '\x0390' = CM '\x03B9' '\x0308' '\x0301'+-- GREEK CAPITAL LETTER ALPHA+foldMapping '\x0391' = CM '\x03B1' '\0' '\0'+-- GREEK CAPITAL LETTER BETA+foldMapping '\x0392' = CM '\x03B2' '\0' '\0'+-- GREEK CAPITAL LETTER GAMMA+foldMapping '\x0393' = CM '\x03B3' '\0' '\0'+-- GREEK CAPITAL LETTER DELTA+foldMapping '\x0394' = CM '\x03B4' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON+foldMapping '\x0395' = CM '\x03B5' '\0' '\0'+-- GREEK CAPITAL LETTER ZETA+foldMapping '\x0396' = CM '\x03B6' '\0' '\0'+-- GREEK CAPITAL LETTER ETA+foldMapping '\x0397' = CM '\x03B7' '\0' '\0'+-- GREEK CAPITAL LETTER THETA+foldMapping '\x0398' = CM '\x03B8' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA+foldMapping '\x0399' = CM '\x03B9' '\0' '\0'+-- GREEK CAPITAL LETTER KAPPA+foldMapping '\x039A' = CM '\x03BA' '\0' '\0'+-- GREEK CAPITAL LETTER LAMDA+foldMapping '\x039B' = CM '\x03BB' '\0' '\0'+-- GREEK CAPITAL LETTER MU+foldMapping '\x039C' = CM '\x03BC' '\0' '\0'+-- GREEK CAPITAL LETTER NU+foldMapping '\x039D' = CM '\x03BD' '\0' '\0'+-- GREEK CAPITAL LETTER XI+foldMapping '\x039E' = CM '\x03BE' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON+foldMapping '\x039F' = CM '\x03BF' '\0' '\0'+-- GREEK CAPITAL LETTER PI+foldMapping '\x03A0' = CM '\x03C0' '\0' '\0'+-- GREEK CAPITAL LETTER RHO+foldMapping '\x03A1' = CM '\x03C1' '\0' '\0'+-- GREEK CAPITAL LETTER SIGMA+foldMapping '\x03A3' = CM '\x03C3' '\0' '\0'+-- GREEK CAPITAL LETTER TAU+foldMapping '\x03A4' = CM '\x03C4' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON+foldMapping '\x03A5' = CM '\x03C5' '\0' '\0'+-- GREEK CAPITAL LETTER PHI+foldMapping '\x03A6' = CM '\x03C6' '\0' '\0'+-- GREEK CAPITAL LETTER CHI+foldMapping '\x03A7' = CM '\x03C7' '\0' '\0'+-- GREEK CAPITAL LETTER PSI+foldMapping '\x03A8' = CM '\x03C8' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA+foldMapping '\x03A9' = CM '\x03C9' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH DIALYTIKA+foldMapping '\x03AA' = CM '\x03CA' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA+foldMapping '\x03AB' = CM '\x03CB' '\0' '\0'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+foldMapping '\x03B0' = CM '\x03C5' '\x0308' '\x0301'+-- GREEK SMALL LETTER FINAL SIGMA+foldMapping '\x03C2' = CM '\x03C3' '\0' '\0'+-- GREEK CAPITAL KAI SYMBOL+foldMapping '\x03CF' = CM '\x03D7' '\0' '\0'+-- GREEK BETA SYMBOL+foldMapping '\x03D0' = CM '\x03B2' '\0' '\0'+-- GREEK THETA SYMBOL+foldMapping '\x03D1' = CM '\x03B8' '\0' '\0'+-- GREEK PHI SYMBOL+foldMapping '\x03D5' = CM '\x03C6' '\0' '\0'+-- GREEK PI SYMBOL+foldMapping '\x03D6' = CM '\x03C0' '\0' '\0'+-- GREEK LETTER ARCHAIC KOPPA+foldMapping '\x03D8' = CM '\x03D9' '\0' '\0'+-- GREEK LETTER STIGMA+foldMapping '\x03DA' = CM '\x03DB' '\0' '\0'+-- GREEK LETTER DIGAMMA+foldMapping '\x03DC' = CM '\x03DD' '\0' '\0'+-- GREEK LETTER KOPPA+foldMapping '\x03DE' = CM '\x03DF' '\0' '\0'+-- GREEK LETTER SAMPI+foldMapping '\x03E0' = CM '\x03E1' '\0' '\0'+-- COPTIC CAPITAL LETTER SHEI+foldMapping '\x03E2' = CM '\x03E3' '\0' '\0'+-- COPTIC CAPITAL LETTER FEI+foldMapping '\x03E4' = CM '\x03E5' '\0' '\0'+-- COPTIC CAPITAL LETTER KHEI+foldMapping '\x03E6' = CM '\x03E7' '\0' '\0'+-- COPTIC CAPITAL LETTER HORI+foldMapping '\x03E8' = CM '\x03E9' '\0' '\0'+-- COPTIC CAPITAL LETTER GANGIA+foldMapping '\x03EA' = CM '\x03EB' '\0' '\0'+-- COPTIC CAPITAL LETTER SHIMA+foldMapping '\x03EC' = CM '\x03ED' '\0' '\0'+-- COPTIC CAPITAL LETTER DEI+foldMapping '\x03EE' = CM '\x03EF' '\0' '\0'+-- GREEK KAPPA SYMBOL+foldMapping '\x03F0' = CM '\x03BA' '\0' '\0'+-- GREEK RHO SYMBOL+foldMapping '\x03F1' = CM '\x03C1' '\0' '\0'+-- GREEK CAPITAL THETA SYMBOL+foldMapping '\x03F4' = CM '\x03B8' '\0' '\0'+-- GREEK LUNATE EPSILON SYMBOL+foldMapping '\x03F5' = CM '\x03B5' '\0' '\0'+-- GREEK CAPITAL LETTER SHO+foldMapping '\x03F7' = CM '\x03F8' '\0' '\0'+-- GREEK CAPITAL LUNATE SIGMA SYMBOL+foldMapping '\x03F9' = CM '\x03F2' '\0' '\0'+-- GREEK CAPITAL LETTER SAN+foldMapping '\x03FA' = CM '\x03FB' '\0' '\0'+-- GREEK CAPITAL REVERSED LUNATE SIGMA SYMBOL+foldMapping '\x03FD' = CM '\x037B' '\0' '\0'+-- GREEK CAPITAL DOTTED LUNATE SIGMA SYMBOL+foldMapping '\x03FE' = CM '\x037C' '\0' '\0'+-- GREEK CAPITAL REVERSED DOTTED LUNATE SIGMA SYMBOL+foldMapping '\x03FF' = CM '\x037D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IE WITH GRAVE+foldMapping '\x0400' = CM '\x0450' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IO+foldMapping '\x0401' = CM '\x0451' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DJE+foldMapping '\x0402' = CM '\x0452' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GJE+foldMapping '\x0403' = CM '\x0453' '\0' '\0'+-- CYRILLIC CAPITAL LETTER UKRAINIAN IE+foldMapping '\x0404' = CM '\x0454' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DZE+foldMapping '\x0405' = CM '\x0455' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I+foldMapping '\x0406' = CM '\x0456' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YI+foldMapping '\x0407' = CM '\x0457' '\0' '\0'+-- CYRILLIC CAPITAL LETTER JE+foldMapping '\x0408' = CM '\x0458' '\0' '\0'+-- CYRILLIC CAPITAL LETTER LJE+foldMapping '\x0409' = CM '\x0459' '\0' '\0'+-- CYRILLIC CAPITAL LETTER NJE+foldMapping '\x040A' = CM '\x045A' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TSHE+foldMapping '\x040B' = CM '\x045B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KJE+foldMapping '\x040C' = CM '\x045C' '\0' '\0'+-- CYRILLIC CAPITAL LETTER I WITH GRAVE+foldMapping '\x040D' = CM '\x045D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHORT U+foldMapping '\x040E' = CM '\x045E' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DZHE+foldMapping '\x040F' = CM '\x045F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER A+foldMapping '\x0410' = CM '\x0430' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BE+foldMapping '\x0411' = CM '\x0431' '\0' '\0'+-- CYRILLIC CAPITAL LETTER VE+foldMapping '\x0412' = CM '\x0432' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GHE+foldMapping '\x0413' = CM '\x0433' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DE+foldMapping '\x0414' = CM '\x0434' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IE+foldMapping '\x0415' = CM '\x0435' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZHE+foldMapping '\x0416' = CM '\x0436' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZE+foldMapping '\x0417' = CM '\x0437' '\0' '\0'+-- CYRILLIC CAPITAL LETTER I+foldMapping '\x0418' = CM '\x0438' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHORT I+foldMapping '\x0419' = CM '\x0439' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KA+foldMapping '\x041A' = CM '\x043A' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EL+foldMapping '\x041B' = CM '\x043B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EM+foldMapping '\x041C' = CM '\x043C' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EN+foldMapping '\x041D' = CM '\x043D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER O+foldMapping '\x041E' = CM '\x043E' '\0' '\0'+-- CYRILLIC CAPITAL LETTER PE+foldMapping '\x041F' = CM '\x043F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ER+foldMapping '\x0420' = CM '\x0440' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ES+foldMapping '\x0421' = CM '\x0441' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TE+foldMapping '\x0422' = CM '\x0442' '\0' '\0'+-- CYRILLIC CAPITAL LETTER U+foldMapping '\x0423' = CM '\x0443' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EF+foldMapping '\x0424' = CM '\x0444' '\0' '\0'+-- CYRILLIC CAPITAL LETTER HA+foldMapping '\x0425' = CM '\x0445' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TSE+foldMapping '\x0426' = CM '\x0446' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CHE+foldMapping '\x0427' = CM '\x0447' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHA+foldMapping '\x0428' = CM '\x0448' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHCHA+foldMapping '\x0429' = CM '\x0449' '\0' '\0'+-- CYRILLIC CAPITAL LETTER HARD SIGN+foldMapping '\x042A' = CM '\x044A' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YERU+foldMapping '\x042B' = CM '\x044B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SOFT SIGN+foldMapping '\x042C' = CM '\x044C' '\0' '\0'+-- CYRILLIC CAPITAL LETTER E+foldMapping '\x042D' = CM '\x044D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YU+foldMapping '\x042E' = CM '\x044E' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YA+foldMapping '\x042F' = CM '\x044F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER OMEGA+foldMapping '\x0460' = CM '\x0461' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YAT+foldMapping '\x0462' = CM '\x0463' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTIFIED E+foldMapping '\x0464' = CM '\x0465' '\0' '\0'+-- CYRILLIC CAPITAL LETTER LITTLE YUS+foldMapping '\x0466' = CM '\x0467' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTIFIED LITTLE YUS+foldMapping '\x0468' = CM '\x0469' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BIG YUS+foldMapping '\x046A' = CM '\x046B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTIFIED BIG YUS+foldMapping '\x046C' = CM '\x046D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KSI+foldMapping '\x046E' = CM '\x046F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER PSI+foldMapping '\x0470' = CM '\x0471' '\0' '\0'+-- CYRILLIC CAPITAL LETTER FITA+foldMapping '\x0472' = CM '\x0473' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IZHITSA+foldMapping '\x0474' = CM '\x0475' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT+foldMapping '\x0476' = CM '\x0477' '\0' '\0'+-- CYRILLIC CAPITAL LETTER UK+foldMapping '\x0478' = CM '\x0479' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ROUND OMEGA+foldMapping '\x047A' = CM '\x047B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER OMEGA WITH TITLO+foldMapping '\x047C' = CM '\x047D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER OT+foldMapping '\x047E' = CM '\x047F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOPPA+foldMapping '\x0480' = CM '\x0481' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHORT I WITH TAIL+foldMapping '\x048A' = CM '\x048B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SEMISOFT SIGN+foldMapping '\x048C' = CM '\x048D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ER WITH TICK+foldMapping '\x048E' = CM '\x048F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GHE WITH UPTURN+foldMapping '\x0490' = CM '\x0491' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GHE WITH STROKE+foldMapping '\x0492' = CM '\x0493' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GHE WITH MIDDLE HOOK+foldMapping '\x0494' = CM '\x0495' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER+foldMapping '\x0496' = CM '\x0497' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZE WITH DESCENDER+foldMapping '\x0498' = CM '\x0499' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KA WITH DESCENDER+foldMapping '\x049A' = CM '\x049B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE+foldMapping '\x049C' = CM '\x049D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KA WITH STROKE+foldMapping '\x049E' = CM '\x049F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BASHKIR KA+foldMapping '\x04A0' = CM '\x04A1' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EN WITH DESCENDER+foldMapping '\x04A2' = CM '\x04A3' '\0' '\0'+-- CYRILLIC CAPITAL LIGATURE EN GHE+foldMapping '\x04A4' = CM '\x04A5' '\0' '\0'+-- CYRILLIC CAPITAL LETTER PE WITH MIDDLE HOOK+foldMapping '\x04A6' = CM '\x04A7' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ABKHASIAN HA+foldMapping '\x04A8' = CM '\x04A9' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ES WITH DESCENDER+foldMapping '\x04AA' = CM '\x04AB' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TE WITH DESCENDER+foldMapping '\x04AC' = CM '\x04AD' '\0' '\0'+-- CYRILLIC CAPITAL LETTER STRAIGHT U+foldMapping '\x04AE' = CM '\x04AF' '\0' '\0'+-- CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE+foldMapping '\x04B0' = CM '\x04B1' '\0' '\0'+-- CYRILLIC CAPITAL LETTER HA WITH DESCENDER+foldMapping '\x04B2' = CM '\x04B3' '\0' '\0'+-- CYRILLIC CAPITAL LIGATURE TE TSE+foldMapping '\x04B4' = CM '\x04B5' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CHE WITH DESCENDER+foldMapping '\x04B6' = CM '\x04B7' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE+foldMapping '\x04B8' = CM '\x04B9' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHHA+foldMapping '\x04BA' = CM '\x04BB' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ABKHASIAN CHE+foldMapping '\x04BC' = CM '\x04BD' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ABKHASIAN CHE WITH DESCENDER+foldMapping '\x04BE' = CM '\x04BF' '\0' '\0'+-- CYRILLIC LETTER PALOCHKA+foldMapping '\x04C0' = CM '\x04CF' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZHE WITH BREVE+foldMapping '\x04C1' = CM '\x04C2' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KA WITH HOOK+foldMapping '\x04C3' = CM '\x04C4' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EL WITH TAIL+foldMapping '\x04C5' = CM '\x04C6' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EN WITH HOOK+foldMapping '\x04C7' = CM '\x04C8' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EN WITH TAIL+foldMapping '\x04C9' = CM '\x04CA' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KHAKASSIAN CHE+foldMapping '\x04CB' = CM '\x04CC' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EM WITH TAIL+foldMapping '\x04CD' = CM '\x04CE' '\0' '\0'+-- CYRILLIC CAPITAL LETTER A WITH BREVE+foldMapping '\x04D0' = CM '\x04D1' '\0' '\0'+-- CYRILLIC CAPITAL LETTER A WITH DIAERESIS+foldMapping '\x04D2' = CM '\x04D3' '\0' '\0'+-- CYRILLIC CAPITAL LIGATURE A IE+foldMapping '\x04D4' = CM '\x04D5' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IE WITH BREVE+foldMapping '\x04D6' = CM '\x04D7' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SCHWA+foldMapping '\x04D8' = CM '\x04D9' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SCHWA WITH DIAERESIS+foldMapping '\x04DA' = CM '\x04DB' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZHE WITH DIAERESIS+foldMapping '\x04DC' = CM '\x04DD' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZE WITH DIAERESIS+foldMapping '\x04DE' = CM '\x04DF' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ABKHASIAN DZE+foldMapping '\x04E0' = CM '\x04E1' '\0' '\0'+-- CYRILLIC CAPITAL LETTER I WITH MACRON+foldMapping '\x04E2' = CM '\x04E3' '\0' '\0'+-- CYRILLIC CAPITAL LETTER I WITH DIAERESIS+foldMapping '\x04E4' = CM '\x04E5' '\0' '\0'+-- CYRILLIC CAPITAL LETTER O WITH DIAERESIS+foldMapping '\x04E6' = CM '\x04E7' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BARRED O+foldMapping '\x04E8' = CM '\x04E9' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BARRED O WITH DIAERESIS+foldMapping '\x04EA' = CM '\x04EB' '\0' '\0'+-- CYRILLIC CAPITAL LETTER E WITH DIAERESIS+foldMapping '\x04EC' = CM '\x04ED' '\0' '\0'+-- CYRILLIC CAPITAL LETTER U WITH MACRON+foldMapping '\x04EE' = CM '\x04EF' '\0' '\0'+-- CYRILLIC CAPITAL LETTER U WITH DIAERESIS+foldMapping '\x04F0' = CM '\x04F1' '\0' '\0'+-- CYRILLIC CAPITAL LETTER U WITH DOUBLE ACUTE+foldMapping '\x04F2' = CM '\x04F3' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CHE WITH DIAERESIS+foldMapping '\x04F4' = CM '\x04F5' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GHE WITH DESCENDER+foldMapping '\x04F6' = CM '\x04F7' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS+foldMapping '\x04F8' = CM '\x04F9' '\0' '\0'+-- CYRILLIC CAPITAL LETTER GHE WITH STROKE AND HOOK+foldMapping '\x04FA' = CM '\x04FB' '\0' '\0'+-- CYRILLIC CAPITAL LETTER HA WITH HOOK+foldMapping '\x04FC' = CM '\x04FD' '\0' '\0'+-- CYRILLIC CAPITAL LETTER HA WITH STROKE+foldMapping '\x04FE' = CM '\x04FF' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI DE+foldMapping '\x0500' = CM '\x0501' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI DJE+foldMapping '\x0502' = CM '\x0503' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI ZJE+foldMapping '\x0504' = CM '\x0505' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI DZJE+foldMapping '\x0506' = CM '\x0507' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI LJE+foldMapping '\x0508' = CM '\x0509' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI NJE+foldMapping '\x050A' = CM '\x050B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI SJE+foldMapping '\x050C' = CM '\x050D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER KOMI TJE+foldMapping '\x050E' = CM '\x050F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER REVERSED ZE+foldMapping '\x0510' = CM '\x0511' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EL WITH HOOK+foldMapping '\x0512' = CM '\x0513' '\0' '\0'+-- CYRILLIC CAPITAL LETTER LHA+foldMapping '\x0514' = CM '\x0515' '\0' '\0'+-- CYRILLIC CAPITAL LETTER RHA+foldMapping '\x0516' = CM '\x0517' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YAE+foldMapping '\x0518' = CM '\x0519' '\0' '\0'+-- CYRILLIC CAPITAL LETTER QA+foldMapping '\x051A' = CM '\x051B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER WE+foldMapping '\x051C' = CM '\x051D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ALEUT KA+foldMapping '\x051E' = CM '\x051F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EL WITH MIDDLE HOOK+foldMapping '\x0520' = CM '\x0521' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EN WITH MIDDLE HOOK+foldMapping '\x0522' = CM '\x0523' '\0' '\0'+-- CYRILLIC CAPITAL LETTER PE WITH DESCENDER+foldMapping '\x0524' = CM '\x0525' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHHA WITH DESCENDER+foldMapping '\x0526' = CM '\x0527' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EN WITH LEFT HOOK+foldMapping '\x0528' = CM '\x0529' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DZZHE+foldMapping '\x052A' = CM '\x052B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DCHE+foldMapping '\x052C' = CM '\x052D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER EL WITH DESCENDER+foldMapping '\x052E' = CM '\x052F' '\0' '\0'+-- ARMENIAN CAPITAL LETTER AYB+foldMapping '\x0531' = CM '\x0561' '\0' '\0'+-- ARMENIAN CAPITAL LETTER BEN+foldMapping '\x0532' = CM '\x0562' '\0' '\0'+-- ARMENIAN CAPITAL LETTER GIM+foldMapping '\x0533' = CM '\x0563' '\0' '\0'+-- ARMENIAN CAPITAL LETTER DA+foldMapping '\x0534' = CM '\x0564' '\0' '\0'+-- ARMENIAN CAPITAL LETTER ECH+foldMapping '\x0535' = CM '\x0565' '\0' '\0'+-- ARMENIAN CAPITAL LETTER ZA+foldMapping '\x0536' = CM '\x0566' '\0' '\0'+-- ARMENIAN CAPITAL LETTER EH+foldMapping '\x0537' = CM '\x0567' '\0' '\0'+-- ARMENIAN CAPITAL LETTER ET+foldMapping '\x0538' = CM '\x0568' '\0' '\0'+-- ARMENIAN CAPITAL LETTER TO+foldMapping '\x0539' = CM '\x0569' '\0' '\0'+-- ARMENIAN CAPITAL LETTER ZHE+foldMapping '\x053A' = CM '\x056A' '\0' '\0'+-- ARMENIAN CAPITAL LETTER INI+foldMapping '\x053B' = CM '\x056B' '\0' '\0'+-- ARMENIAN CAPITAL LETTER LIWN+foldMapping '\x053C' = CM '\x056C' '\0' '\0'+-- ARMENIAN CAPITAL LETTER XEH+foldMapping '\x053D' = CM '\x056D' '\0' '\0'+-- ARMENIAN CAPITAL LETTER CA+foldMapping '\x053E' = CM '\x056E' '\0' '\0'+-- ARMENIAN CAPITAL LETTER KEN+foldMapping '\x053F' = CM '\x056F' '\0' '\0'+-- ARMENIAN CAPITAL LETTER HO+foldMapping '\x0540' = CM '\x0570' '\0' '\0'+-- ARMENIAN CAPITAL LETTER JA+foldMapping '\x0541' = CM '\x0571' '\0' '\0'+-- ARMENIAN CAPITAL LETTER GHAD+foldMapping '\x0542' = CM '\x0572' '\0' '\0'+-- ARMENIAN CAPITAL LETTER CHEH+foldMapping '\x0543' = CM '\x0573' '\0' '\0'+-- ARMENIAN CAPITAL LETTER MEN+foldMapping '\x0544' = CM '\x0574' '\0' '\0'+-- ARMENIAN CAPITAL LETTER YI+foldMapping '\x0545' = CM '\x0575' '\0' '\0'+-- ARMENIAN CAPITAL LETTER NOW+foldMapping '\x0546' = CM '\x0576' '\0' '\0'+-- ARMENIAN CAPITAL LETTER SHA+foldMapping '\x0547' = CM '\x0577' '\0' '\0'+-- ARMENIAN CAPITAL LETTER VO+foldMapping '\x0548' = CM '\x0578' '\0' '\0'+-- ARMENIAN CAPITAL LETTER CHA+foldMapping '\x0549' = CM '\x0579' '\0' '\0'+-- ARMENIAN CAPITAL LETTER PEH+foldMapping '\x054A' = CM '\x057A' '\0' '\0'+-- ARMENIAN CAPITAL LETTER JHEH+foldMapping '\x054B' = CM '\x057B' '\0' '\0'+-- ARMENIAN CAPITAL LETTER RA+foldMapping '\x054C' = CM '\x057C' '\0' '\0'+-- ARMENIAN CAPITAL LETTER SEH+foldMapping '\x054D' = CM '\x057D' '\0' '\0'+-- ARMENIAN CAPITAL LETTER VEW+foldMapping '\x054E' = CM '\x057E' '\0' '\0'+-- ARMENIAN CAPITAL LETTER TIWN+foldMapping '\x054F' = CM '\x057F' '\0' '\0'+-- ARMENIAN CAPITAL LETTER REH+foldMapping '\x0550' = CM '\x0580' '\0' '\0'+-- ARMENIAN CAPITAL LETTER CO+foldMapping '\x0551' = CM '\x0581' '\0' '\0'+-- ARMENIAN CAPITAL LETTER YIWN+foldMapping '\x0552' = CM '\x0582' '\0' '\0'+-- ARMENIAN CAPITAL LETTER PIWR+foldMapping '\x0553' = CM '\x0583' '\0' '\0'+-- ARMENIAN CAPITAL LETTER KEH+foldMapping '\x0554' = CM '\x0584' '\0' '\0'+-- ARMENIAN CAPITAL LETTER OH+foldMapping '\x0555' = CM '\x0585' '\0' '\0'+-- ARMENIAN CAPITAL LETTER FEH+foldMapping '\x0556' = CM '\x0586' '\0' '\0'+-- ARMENIAN SMALL LIGATURE ECH YIWN+foldMapping '\x0587' = CM '\x0565' '\x0582' '\0'+-- GEORGIAN CAPITAL LETTER AN+foldMapping '\x10A0' = CM '\x2D00' '\0' '\0'+-- GEORGIAN CAPITAL LETTER BAN+foldMapping '\x10A1' = CM '\x2D01' '\0' '\0'+-- GEORGIAN CAPITAL LETTER GAN+foldMapping '\x10A2' = CM '\x2D02' '\0' '\0'+-- GEORGIAN CAPITAL LETTER DON+foldMapping '\x10A3' = CM '\x2D03' '\0' '\0'+-- GEORGIAN CAPITAL LETTER EN+foldMapping '\x10A4' = CM '\x2D04' '\0' '\0'+-- GEORGIAN CAPITAL LETTER VIN+foldMapping '\x10A5' = CM '\x2D05' '\0' '\0'+-- GEORGIAN CAPITAL LETTER ZEN+foldMapping '\x10A6' = CM '\x2D06' '\0' '\0'+-- GEORGIAN CAPITAL LETTER TAN+foldMapping '\x10A7' = CM '\x2D07' '\0' '\0'+-- GEORGIAN CAPITAL LETTER IN+foldMapping '\x10A8' = CM '\x2D08' '\0' '\0'+-- GEORGIAN CAPITAL LETTER KAN+foldMapping '\x10A9' = CM '\x2D09' '\0' '\0'+-- GEORGIAN CAPITAL LETTER LAS+foldMapping '\x10AA' = CM '\x2D0A' '\0' '\0'+-- GEORGIAN CAPITAL LETTER MAN+foldMapping '\x10AB' = CM '\x2D0B' '\0' '\0'+-- GEORGIAN CAPITAL LETTER NAR+foldMapping '\x10AC' = CM '\x2D0C' '\0' '\0'+-- GEORGIAN CAPITAL LETTER ON+foldMapping '\x10AD' = CM '\x2D0D' '\0' '\0'+-- GEORGIAN CAPITAL LETTER PAR+foldMapping '\x10AE' = CM '\x2D0E' '\0' '\0'+-- GEORGIAN CAPITAL LETTER ZHAR+foldMapping '\x10AF' = CM '\x2D0F' '\0' '\0'+-- GEORGIAN CAPITAL LETTER RAE+foldMapping '\x10B0' = CM '\x2D10' '\0' '\0'+-- GEORGIAN CAPITAL LETTER SAN+foldMapping '\x10B1' = CM '\x2D11' '\0' '\0'+-- GEORGIAN CAPITAL LETTER TAR+foldMapping '\x10B2' = CM '\x2D12' '\0' '\0'+-- GEORGIAN CAPITAL LETTER UN+foldMapping '\x10B3' = CM '\x2D13' '\0' '\0'+-- GEORGIAN CAPITAL LETTER PHAR+foldMapping '\x10B4' = CM '\x2D14' '\0' '\0'+-- GEORGIAN CAPITAL LETTER KHAR+foldMapping '\x10B5' = CM '\x2D15' '\0' '\0'+-- GEORGIAN CAPITAL LETTER GHAN+foldMapping '\x10B6' = CM '\x2D16' '\0' '\0'+-- GEORGIAN CAPITAL LETTER QAR+foldMapping '\x10B7' = CM '\x2D17' '\0' '\0'+-- GEORGIAN CAPITAL LETTER SHIN+foldMapping '\x10B8' = CM '\x2D18' '\0' '\0'+-- GEORGIAN CAPITAL LETTER CHIN+foldMapping '\x10B9' = CM '\x2D19' '\0' '\0'+-- GEORGIAN CAPITAL LETTER CAN+foldMapping '\x10BA' = CM '\x2D1A' '\0' '\0'+-- GEORGIAN CAPITAL LETTER JIL+foldMapping '\x10BB' = CM '\x2D1B' '\0' '\0'+-- GEORGIAN CAPITAL LETTER CIL+foldMapping '\x10BC' = CM '\x2D1C' '\0' '\0'+-- GEORGIAN CAPITAL LETTER CHAR+foldMapping '\x10BD' = CM '\x2D1D' '\0' '\0'+-- GEORGIAN CAPITAL LETTER XAN+foldMapping '\x10BE' = CM '\x2D1E' '\0' '\0'+-- GEORGIAN CAPITAL LETTER JHAN+foldMapping '\x10BF' = CM '\x2D1F' '\0' '\0'+-- GEORGIAN CAPITAL LETTER HAE+foldMapping '\x10C0' = CM '\x2D20' '\0' '\0'+-- GEORGIAN CAPITAL LETTER HE+foldMapping '\x10C1' = CM '\x2D21' '\0' '\0'+-- GEORGIAN CAPITAL LETTER HIE+foldMapping '\x10C2' = CM '\x2D22' '\0' '\0'+-- GEORGIAN CAPITAL LETTER WE+foldMapping '\x10C3' = CM '\x2D23' '\0' '\0'+-- GEORGIAN CAPITAL LETTER HAR+foldMapping '\x10C4' = CM '\x2D24' '\0' '\0'+-- GEORGIAN CAPITAL LETTER HOE+foldMapping '\x10C5' = CM '\x2D25' '\0' '\0'+-- GEORGIAN CAPITAL LETTER YN+foldMapping '\x10C7' = CM '\x2D27' '\0' '\0'+-- GEORGIAN CAPITAL LETTER AEN+foldMapping '\x10CD' = CM '\x2D2D' '\0' '\0'+-- CHEROKEE SMALL LETTER YE+foldMapping '\x13F8' = CM '\x13F0' '\0' '\0'+-- CHEROKEE SMALL LETTER YI+foldMapping '\x13F9' = CM '\x13F1' '\0' '\0'+-- CHEROKEE SMALL LETTER YO+foldMapping '\x13FA' = CM '\x13F2' '\0' '\0'+-- CHEROKEE SMALL LETTER YU+foldMapping '\x13FB' = CM '\x13F3' '\0' '\0'+-- CHEROKEE SMALL LETTER YV+foldMapping '\x13FC' = CM '\x13F4' '\0' '\0'+-- CHEROKEE SMALL LETTER MV+foldMapping '\x13FD' = CM '\x13F5' '\0' '\0'+-- CYRILLIC SMALL LETTER ROUNDED VE+foldMapping '\x1C80' = CM '\x0432' '\0' '\0'+-- CYRILLIC SMALL LETTER LONG-LEGGED DE+foldMapping '\x1C81' = CM '\x0434' '\0' '\0'+-- CYRILLIC SMALL LETTER NARROW O+foldMapping '\x1C82' = CM '\x043E' '\0' '\0'+-- CYRILLIC SMALL LETTER WIDE ES+foldMapping '\x1C83' = CM '\x0441' '\0' '\0'+-- CYRILLIC SMALL LETTER TALL TE+foldMapping '\x1C84' = CM '\x0442' '\0' '\0'+-- CYRILLIC SMALL LETTER THREE-LEGGED TE+foldMapping '\x1C85' = CM '\x0442' '\0' '\0'+-- CYRILLIC SMALL LETTER TALL HARD SIGN+foldMapping '\x1C86' = CM '\x044A' '\0' '\0'+-- CYRILLIC SMALL LETTER TALL YAT+foldMapping '\x1C87' = CM '\x0463' '\0' '\0'+-- CYRILLIC SMALL LETTER UNBLENDED UK+foldMapping '\x1C88' = CM '\xA64B' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH RING BELOW+foldMapping '\x1E00' = CM '\x1E01' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH DOT ABOVE+foldMapping '\x1E02' = CM '\x1E03' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH DOT BELOW+foldMapping '\x1E04' = CM '\x1E05' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH LINE BELOW+foldMapping '\x1E06' = CM '\x1E07' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH CEDILLA AND ACUTE+foldMapping '\x1E08' = CM '\x1E09' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH DOT ABOVE+foldMapping '\x1E0A' = CM '\x1E0B' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH DOT BELOW+foldMapping '\x1E0C' = CM '\x1E0D' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH LINE BELOW+foldMapping '\x1E0E' = CM '\x1E0F' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH CEDILLA+foldMapping '\x1E10' = CM '\x1E11' '\0' '\0'+-- LATIN CAPITAL LETTER D WITH CIRCUMFLEX BELOW+foldMapping '\x1E12' = CM '\x1E13' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH MACRON AND GRAVE+foldMapping '\x1E14' = CM '\x1E15' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH MACRON AND ACUTE+foldMapping '\x1E16' = CM '\x1E17' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX BELOW+foldMapping '\x1E18' = CM '\x1E19' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH TILDE BELOW+foldMapping '\x1E1A' = CM '\x1E1B' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CEDILLA AND BREVE+foldMapping '\x1E1C' = CM '\x1E1D' '\0' '\0'+-- LATIN CAPITAL LETTER F WITH DOT ABOVE+foldMapping '\x1E1E' = CM '\x1E1F' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH MACRON+foldMapping '\x1E20' = CM '\x1E21' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH DOT ABOVE+foldMapping '\x1E22' = CM '\x1E23' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH DOT BELOW+foldMapping '\x1E24' = CM '\x1E25' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH DIAERESIS+foldMapping '\x1E26' = CM '\x1E27' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH CEDILLA+foldMapping '\x1E28' = CM '\x1E29' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH BREVE BELOW+foldMapping '\x1E2A' = CM '\x1E2B' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH TILDE BELOW+foldMapping '\x1E2C' = CM '\x1E2D' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH DIAERESIS AND ACUTE+foldMapping '\x1E2E' = CM '\x1E2F' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH ACUTE+foldMapping '\x1E30' = CM '\x1E31' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH DOT BELOW+foldMapping '\x1E32' = CM '\x1E33' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH LINE BELOW+foldMapping '\x1E34' = CM '\x1E35' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH DOT BELOW+foldMapping '\x1E36' = CM '\x1E37' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH DOT BELOW AND MACRON+foldMapping '\x1E38' = CM '\x1E39' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH LINE BELOW+foldMapping '\x1E3A' = CM '\x1E3B' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH CIRCUMFLEX BELOW+foldMapping '\x1E3C' = CM '\x1E3D' '\0' '\0'+-- LATIN CAPITAL LETTER M WITH ACUTE+foldMapping '\x1E3E' = CM '\x1E3F' '\0' '\0'+-- LATIN CAPITAL LETTER M WITH DOT ABOVE+foldMapping '\x1E40' = CM '\x1E41' '\0' '\0'+-- LATIN CAPITAL LETTER M WITH DOT BELOW+foldMapping '\x1E42' = CM '\x1E43' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH DOT ABOVE+foldMapping '\x1E44' = CM '\x1E45' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH DOT BELOW+foldMapping '\x1E46' = CM '\x1E47' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH LINE BELOW+foldMapping '\x1E48' = CM '\x1E49' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH CIRCUMFLEX BELOW+foldMapping '\x1E4A' = CM '\x1E4B' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH TILDE AND ACUTE+foldMapping '\x1E4C' = CM '\x1E4D' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH TILDE AND DIAERESIS+foldMapping '\x1E4E' = CM '\x1E4F' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH MACRON AND GRAVE+foldMapping '\x1E50' = CM '\x1E51' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH MACRON AND ACUTE+foldMapping '\x1E52' = CM '\x1E53' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH ACUTE+foldMapping '\x1E54' = CM '\x1E55' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH DOT ABOVE+foldMapping '\x1E56' = CM '\x1E57' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH DOT ABOVE+foldMapping '\x1E58' = CM '\x1E59' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH DOT BELOW+foldMapping '\x1E5A' = CM '\x1E5B' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH DOT BELOW AND MACRON+foldMapping '\x1E5C' = CM '\x1E5D' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH LINE BELOW+foldMapping '\x1E5E' = CM '\x1E5F' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH DOT ABOVE+foldMapping '\x1E60' = CM '\x1E61' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH DOT BELOW+foldMapping '\x1E62' = CM '\x1E63' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH ACUTE AND DOT ABOVE+foldMapping '\x1E64' = CM '\x1E65' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH CARON AND DOT ABOVE+foldMapping '\x1E66' = CM '\x1E67' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH DOT BELOW AND DOT ABOVE+foldMapping '\x1E68' = CM '\x1E69' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH DOT ABOVE+foldMapping '\x1E6A' = CM '\x1E6B' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH DOT BELOW+foldMapping '\x1E6C' = CM '\x1E6D' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH LINE BELOW+foldMapping '\x1E6E' = CM '\x1E6F' '\0' '\0'+-- LATIN CAPITAL LETTER T WITH CIRCUMFLEX BELOW+foldMapping '\x1E70' = CM '\x1E71' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DIAERESIS BELOW+foldMapping '\x1E72' = CM '\x1E73' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH TILDE BELOW+foldMapping '\x1E74' = CM '\x1E75' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH CIRCUMFLEX BELOW+foldMapping '\x1E76' = CM '\x1E77' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH TILDE AND ACUTE+foldMapping '\x1E78' = CM '\x1E79' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH MACRON AND DIAERESIS+foldMapping '\x1E7A' = CM '\x1E7B' '\0' '\0'+-- LATIN CAPITAL LETTER V WITH TILDE+foldMapping '\x1E7C' = CM '\x1E7D' '\0' '\0'+-- LATIN CAPITAL LETTER V WITH DOT BELOW+foldMapping '\x1E7E' = CM '\x1E7F' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH GRAVE+foldMapping '\x1E80' = CM '\x1E81' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH ACUTE+foldMapping '\x1E82' = CM '\x1E83' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH DIAERESIS+foldMapping '\x1E84' = CM '\x1E85' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH DOT ABOVE+foldMapping '\x1E86' = CM '\x1E87' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH DOT BELOW+foldMapping '\x1E88' = CM '\x1E89' '\0' '\0'+-- LATIN CAPITAL LETTER X WITH DOT ABOVE+foldMapping '\x1E8A' = CM '\x1E8B' '\0' '\0'+-- LATIN CAPITAL LETTER X WITH DIAERESIS+foldMapping '\x1E8C' = CM '\x1E8D' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH DOT ABOVE+foldMapping '\x1E8E' = CM '\x1E8F' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH CIRCUMFLEX+foldMapping '\x1E90' = CM '\x1E91' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH DOT BELOW+foldMapping '\x1E92' = CM '\x1E93' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH LINE BELOW+foldMapping '\x1E94' = CM '\x1E95' '\0' '\0'+-- LATIN SMALL LETTER H WITH LINE BELOW+foldMapping '\x1E96' = CM '\x0068' '\x0331' '\0'+-- LATIN SMALL LETTER T WITH DIAERESIS+foldMapping '\x1E97' = CM '\x0074' '\x0308' '\0'+-- LATIN SMALL LETTER W WITH RING ABOVE+foldMapping '\x1E98' = CM '\x0077' '\x030A' '\0'+-- LATIN SMALL LETTER Y WITH RING ABOVE+foldMapping '\x1E99' = CM '\x0079' '\x030A' '\0'+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+foldMapping '\x1E9A' = CM '\x0061' '\x02BE' '\0'+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE+foldMapping '\x1E9B' = CM '\x1E61' '\0' '\0'+-- LATIN CAPITAL LETTER SHARP S+foldMapping '\x1E9E' = CM '\x0073' '\x0073' '\0'+-- LATIN CAPITAL LETTER A WITH DOT BELOW+foldMapping '\x1EA0' = CM '\x1EA1' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH HOOK ABOVE+foldMapping '\x1EA2' = CM '\x1EA3' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE+foldMapping '\x1EA4' = CM '\x1EA5' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE+foldMapping '\x1EA6' = CM '\x1EA7' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE+foldMapping '\x1EA8' = CM '\x1EA9' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE+foldMapping '\x1EAA' = CM '\x1EAB' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW+foldMapping '\x1EAC' = CM '\x1EAD' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH BREVE AND ACUTE+foldMapping '\x1EAE' = CM '\x1EAF' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH BREVE AND GRAVE+foldMapping '\x1EB0' = CM '\x1EB1' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE+foldMapping '\x1EB2' = CM '\x1EB3' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH BREVE AND TILDE+foldMapping '\x1EB4' = CM '\x1EB5' '\0' '\0'+-- LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW+foldMapping '\x1EB6' = CM '\x1EB7' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH DOT BELOW+foldMapping '\x1EB8' = CM '\x1EB9' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH HOOK ABOVE+foldMapping '\x1EBA' = CM '\x1EBB' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH TILDE+foldMapping '\x1EBC' = CM '\x1EBD' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE+foldMapping '\x1EBE' = CM '\x1EBF' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE+foldMapping '\x1EC0' = CM '\x1EC1' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE+foldMapping '\x1EC2' = CM '\x1EC3' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE+foldMapping '\x1EC4' = CM '\x1EC5' '\0' '\0'+-- LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW+foldMapping '\x1EC6' = CM '\x1EC7' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH HOOK ABOVE+foldMapping '\x1EC8' = CM '\x1EC9' '\0' '\0'+-- LATIN CAPITAL LETTER I WITH DOT BELOW+foldMapping '\x1ECA' = CM '\x1ECB' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH DOT BELOW+foldMapping '\x1ECC' = CM '\x1ECD' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HOOK ABOVE+foldMapping '\x1ECE' = CM '\x1ECF' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE+foldMapping '\x1ED0' = CM '\x1ED1' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE+foldMapping '\x1ED2' = CM '\x1ED3' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE+foldMapping '\x1ED4' = CM '\x1ED5' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE+foldMapping '\x1ED6' = CM '\x1ED7' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW+foldMapping '\x1ED8' = CM '\x1ED9' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HORN AND ACUTE+foldMapping '\x1EDA' = CM '\x1EDB' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HORN AND GRAVE+foldMapping '\x1EDC' = CM '\x1EDD' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE+foldMapping '\x1EDE' = CM '\x1EDF' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HORN AND TILDE+foldMapping '\x1EE0' = CM '\x1EE1' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW+foldMapping '\x1EE2' = CM '\x1EE3' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH DOT BELOW+foldMapping '\x1EE4' = CM '\x1EE5' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HOOK ABOVE+foldMapping '\x1EE6' = CM '\x1EE7' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HORN AND ACUTE+foldMapping '\x1EE8' = CM '\x1EE9' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HORN AND GRAVE+foldMapping '\x1EEA' = CM '\x1EEB' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE+foldMapping '\x1EEC' = CM '\x1EED' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HORN AND TILDE+foldMapping '\x1EEE' = CM '\x1EEF' '\0' '\0'+-- LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW+foldMapping '\x1EF0' = CM '\x1EF1' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH GRAVE+foldMapping '\x1EF2' = CM '\x1EF3' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH DOT BELOW+foldMapping '\x1EF4' = CM '\x1EF5' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH HOOK ABOVE+foldMapping '\x1EF6' = CM '\x1EF7' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH TILDE+foldMapping '\x1EF8' = CM '\x1EF9' '\0' '\0'+-- LATIN CAPITAL LETTER MIDDLE-WELSH LL+foldMapping '\x1EFA' = CM '\x1EFB' '\0' '\0'+-- LATIN CAPITAL LETTER MIDDLE-WELSH V+foldMapping '\x1EFC' = CM '\x1EFD' '\0' '\0'+-- LATIN CAPITAL LETTER Y WITH LOOP+foldMapping '\x1EFE' = CM '\x1EFF' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI+foldMapping '\x1F08' = CM '\x1F00' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA+foldMapping '\x1F09' = CM '\x1F01' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA+foldMapping '\x1F0A' = CM '\x1F02' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA+foldMapping '\x1F0B' = CM '\x1F03' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA+foldMapping '\x1F0C' = CM '\x1F04' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA+foldMapping '\x1F0D' = CM '\x1F05' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI+foldMapping '\x1F0E' = CM '\x1F06' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI+foldMapping '\x1F0F' = CM '\x1F07' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH PSILI+foldMapping '\x1F18' = CM '\x1F10' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH DASIA+foldMapping '\x1F19' = CM '\x1F11' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH PSILI AND VARIA+foldMapping '\x1F1A' = CM '\x1F12' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH DASIA AND VARIA+foldMapping '\x1F1B' = CM '\x1F13' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH PSILI AND OXIA+foldMapping '\x1F1C' = CM '\x1F14' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA+foldMapping '\x1F1D' = CM '\x1F15' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI+foldMapping '\x1F28' = CM '\x1F20' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA+foldMapping '\x1F29' = CM '\x1F21' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA+foldMapping '\x1F2A' = CM '\x1F22' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA+foldMapping '\x1F2B' = CM '\x1F23' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA+foldMapping '\x1F2C' = CM '\x1F24' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA+foldMapping '\x1F2D' = CM '\x1F25' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI+foldMapping '\x1F2E' = CM '\x1F26' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI+foldMapping '\x1F2F' = CM '\x1F27' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH PSILI+foldMapping '\x1F38' = CM '\x1F30' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH DASIA+foldMapping '\x1F39' = CM '\x1F31' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH PSILI AND VARIA+foldMapping '\x1F3A' = CM '\x1F32' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH DASIA AND VARIA+foldMapping '\x1F3B' = CM '\x1F33' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH PSILI AND OXIA+foldMapping '\x1F3C' = CM '\x1F34' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH DASIA AND OXIA+foldMapping '\x1F3D' = CM '\x1F35' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH PSILI AND PERISPOMENI+foldMapping '\x1F3E' = CM '\x1F36' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH DASIA AND PERISPOMENI+foldMapping '\x1F3F' = CM '\x1F37' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH PSILI+foldMapping '\x1F48' = CM '\x1F40' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH DASIA+foldMapping '\x1F49' = CM '\x1F41' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH PSILI AND VARIA+foldMapping '\x1F4A' = CM '\x1F42' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH DASIA AND VARIA+foldMapping '\x1F4B' = CM '\x1F43' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH PSILI AND OXIA+foldMapping '\x1F4C' = CM '\x1F44' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA+foldMapping '\x1F4D' = CM '\x1F45' '\0' '\0'+-- GREEK SMALL LETTER UPSILON WITH PSILI+foldMapping '\x1F50' = CM '\x03C5' '\x0313' '\0'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+foldMapping '\x1F52' = CM '\x03C5' '\x0313' '\x0300'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+foldMapping '\x1F54' = CM '\x03C5' '\x0313' '\x0301'+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+foldMapping '\x1F56' = CM '\x03C5' '\x0313' '\x0342'+-- GREEK CAPITAL LETTER UPSILON WITH DASIA+foldMapping '\x1F59' = CM '\x1F51' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA+foldMapping '\x1F5B' = CM '\x1F53' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA+foldMapping '\x1F5D' = CM '\x1F55' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI+foldMapping '\x1F5F' = CM '\x1F57' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI+foldMapping '\x1F68' = CM '\x1F60' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA+foldMapping '\x1F69' = CM '\x1F61' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA+foldMapping '\x1F6A' = CM '\x1F62' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA+foldMapping '\x1F6B' = CM '\x1F63' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA+foldMapping '\x1F6C' = CM '\x1F64' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA+foldMapping '\x1F6D' = CM '\x1F65' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI+foldMapping '\x1F6E' = CM '\x1F66' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI+foldMapping '\x1F6F' = CM '\x1F67' '\0' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1F80' = CM '\x1F00' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1F81' = CM '\x1F01' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1F82' = CM '\x1F02' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1F83' = CM '\x1F03' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1F84' = CM '\x1F04' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1F85' = CM '\x1F05' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1F86' = CM '\x1F06' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1F87' = CM '\x1F07' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1F88' = CM '\x1F00' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1F89' = CM '\x1F01' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1F8A' = CM '\x1F02' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1F8B' = CM '\x1F03' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1F8C' = CM '\x1F04' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1F8D' = CM '\x1F05' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1F8E' = CM '\x1F06' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1F8F' = CM '\x1F07' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1F90' = CM '\x1F20' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1F91' = CM '\x1F21' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1F92' = CM '\x1F22' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1F93' = CM '\x1F23' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1F94' = CM '\x1F24' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1F95' = CM '\x1F25' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1F96' = CM '\x1F26' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1F97' = CM '\x1F27' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1F98' = CM '\x1F20' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1F99' = CM '\x1F21' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1F9A' = CM '\x1F22' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1F9B' = CM '\x1F23' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1F9C' = CM '\x1F24' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1F9D' = CM '\x1F25' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1F9E' = CM '\x1F26' '\x03B9' '\0'+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1F9F' = CM '\x1F27' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1FA0' = CM '\x1F60' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1FA1' = CM '\x1F61' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1FA2' = CM '\x1F62' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1FA3' = CM '\x1F63' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1FA4' = CM '\x1F64' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1FA5' = CM '\x1F65' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1FA6' = CM '\x1F66' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1FA7' = CM '\x1F67' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1FA8' = CM '\x1F60' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1FA9' = CM '\x1F61' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1FAA' = CM '\x1F62' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1FAB' = CM '\x1F63' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1FAC' = CM '\x1F64' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1FAD' = CM '\x1F65' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1FAE' = CM '\x1F66' '\x03B9' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1FAF' = CM '\x1F67' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1FB2' = CM '\x1F70' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+foldMapping '\x1FB3' = CM '\x03B1' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1FB4' = CM '\x03AC' '\x03B9' '\0'+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+foldMapping '\x1FB6' = CM '\x03B1' '\x0342' '\0'+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1FB7' = CM '\x03B1' '\x0342' '\x03B9'+-- GREEK CAPITAL LETTER ALPHA WITH VRACHY+foldMapping '\x1FB8' = CM '\x1FB0' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH MACRON+foldMapping '\x1FB9' = CM '\x1FB1' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH VARIA+foldMapping '\x1FBA' = CM '\x1F70' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH OXIA+foldMapping '\x1FBB' = CM '\x1F71' '\0' '\0'+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+foldMapping '\x1FBC' = CM '\x03B1' '\x03B9' '\0'+-- GREEK PROSGEGRAMMENI+foldMapping '\x1FBE' = CM '\x03B9' '\0' '\0'+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1FC2' = CM '\x1F74' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+foldMapping '\x1FC3' = CM '\x03B7' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1FC4' = CM '\x03AE' '\x03B9' '\0'+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+foldMapping '\x1FC6' = CM '\x03B7' '\x0342' '\0'+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1FC7' = CM '\x03B7' '\x0342' '\x03B9'+-- GREEK CAPITAL LETTER EPSILON WITH VARIA+foldMapping '\x1FC8' = CM '\x1F72' '\0' '\0'+-- GREEK CAPITAL LETTER EPSILON WITH OXIA+foldMapping '\x1FC9' = CM '\x1F73' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH VARIA+foldMapping '\x1FCA' = CM '\x1F74' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH OXIA+foldMapping '\x1FCB' = CM '\x1F75' '\0' '\0'+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+foldMapping '\x1FCC' = CM '\x03B7' '\x03B9' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+foldMapping '\x1FD2' = CM '\x03B9' '\x0308' '\x0300'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+foldMapping '\x1FD3' = CM '\x03B9' '\x0308' '\x0301'+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+foldMapping '\x1FD6' = CM '\x03B9' '\x0342' '\0'+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1FD7' = CM '\x03B9' '\x0308' '\x0342'+-- GREEK CAPITAL LETTER IOTA WITH VRACHY+foldMapping '\x1FD8' = CM '\x1FD0' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH MACRON+foldMapping '\x1FD9' = CM '\x1FD1' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH VARIA+foldMapping '\x1FDA' = CM '\x1F76' '\0' '\0'+-- GREEK CAPITAL LETTER IOTA WITH OXIA+foldMapping '\x1FDB' = CM '\x1F77' '\0' '\0'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+foldMapping '\x1FE2' = CM '\x03C5' '\x0308' '\x0300'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+foldMapping '\x1FE3' = CM '\x03C5' '\x0308' '\x0301'+-- GREEK SMALL LETTER RHO WITH PSILI+foldMapping '\x1FE4' = CM '\x03C1' '\x0313' '\0'+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+foldMapping '\x1FE6' = CM '\x03C5' '\x0342' '\0'+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1FE7' = CM '\x03C5' '\x0308' '\x0342'+-- GREEK CAPITAL LETTER UPSILON WITH VRACHY+foldMapping '\x1FE8' = CM '\x1FE0' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH MACRON+foldMapping '\x1FE9' = CM '\x1FE1' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH VARIA+foldMapping '\x1FEA' = CM '\x1F7A' '\0' '\0'+-- GREEK CAPITAL LETTER UPSILON WITH OXIA+foldMapping '\x1FEB' = CM '\x1F7B' '\0' '\0'+-- GREEK CAPITAL LETTER RHO WITH DASIA+foldMapping '\x1FEC' = CM '\x1FE5' '\0' '\0'+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1FF2' = CM '\x1F7C' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+foldMapping '\x1FF3' = CM '\x03C9' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1FF4' = CM '\x03CE' '\x03B9' '\0'+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+foldMapping '\x1FF6' = CM '\x03C9' '\x0342' '\0'+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1FF7' = CM '\x03C9' '\x0342' '\x03B9'+-- GREEK CAPITAL LETTER OMICRON WITH VARIA+foldMapping '\x1FF8' = CM '\x1F78' '\0' '\0'+-- GREEK CAPITAL LETTER OMICRON WITH OXIA+foldMapping '\x1FF9' = CM '\x1F79' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH VARIA+foldMapping '\x1FFA' = CM '\x1F7C' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH OXIA+foldMapping '\x1FFB' = CM '\x1F7D' '\0' '\0'+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+foldMapping '\x1FFC' = CM '\x03C9' '\x03B9' '\0'+-- OHM SIGN+foldMapping '\x2126' = CM '\x03C9' '\0' '\0'+-- KELVIN SIGN+foldMapping '\x212A' = CM '\x006B' '\0' '\0'+-- ANGSTROM SIGN+foldMapping '\x212B' = CM '\x00E5' '\0' '\0'+-- TURNED CAPITAL F+foldMapping '\x2132' = CM '\x214E' '\0' '\0'+-- ROMAN NUMERAL ONE+foldMapping '\x2160' = CM '\x2170' '\0' '\0'+-- ROMAN NUMERAL TWO+foldMapping '\x2161' = CM '\x2171' '\0' '\0'+-- ROMAN NUMERAL THREE+foldMapping '\x2162' = CM '\x2172' '\0' '\0'+-- ROMAN NUMERAL FOUR+foldMapping '\x2163' = CM '\x2173' '\0' '\0'+-- ROMAN NUMERAL FIVE+foldMapping '\x2164' = CM '\x2174' '\0' '\0'+-- ROMAN NUMERAL SIX+foldMapping '\x2165' = CM '\x2175' '\0' '\0'+-- ROMAN NUMERAL SEVEN+foldMapping '\x2166' = CM '\x2176' '\0' '\0'+-- ROMAN NUMERAL EIGHT+foldMapping '\x2167' = CM '\x2177' '\0' '\0'+-- ROMAN NUMERAL NINE+foldMapping '\x2168' = CM '\x2178' '\0' '\0'+-- ROMAN NUMERAL TEN+foldMapping '\x2169' = CM '\x2179' '\0' '\0'+-- ROMAN NUMERAL ELEVEN+foldMapping '\x216A' = CM '\x217A' '\0' '\0'+-- ROMAN NUMERAL TWELVE+foldMapping '\x216B' = CM '\x217B' '\0' '\0'+-- ROMAN NUMERAL FIFTY+foldMapping '\x216C' = CM '\x217C' '\0' '\0'+-- ROMAN NUMERAL ONE HUNDRED+foldMapping '\x216D' = CM '\x217D' '\0' '\0'+-- ROMAN NUMERAL FIVE HUNDRED+foldMapping '\x216E' = CM '\x217E' '\0' '\0'+-- ROMAN NUMERAL ONE THOUSAND+foldMapping '\x216F' = CM '\x217F' '\0' '\0'+-- ROMAN NUMERAL REVERSED ONE HUNDRED+foldMapping '\x2183' = CM '\x2184' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER A+foldMapping '\x24B6' = CM '\x24D0' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER B+foldMapping '\x24B7' = CM '\x24D1' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER C+foldMapping '\x24B8' = CM '\x24D2' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER D+foldMapping '\x24B9' = CM '\x24D3' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER E+foldMapping '\x24BA' = CM '\x24D4' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER F+foldMapping '\x24BB' = CM '\x24D5' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER G+foldMapping '\x24BC' = CM '\x24D6' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER H+foldMapping '\x24BD' = CM '\x24D7' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER I+foldMapping '\x24BE' = CM '\x24D8' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER J+foldMapping '\x24BF' = CM '\x24D9' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER K+foldMapping '\x24C0' = CM '\x24DA' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER L+foldMapping '\x24C1' = CM '\x24DB' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER M+foldMapping '\x24C2' = CM '\x24DC' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER N+foldMapping '\x24C3' = CM '\x24DD' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER O+foldMapping '\x24C4' = CM '\x24DE' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER P+foldMapping '\x24C5' = CM '\x24DF' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER Q+foldMapping '\x24C6' = CM '\x24E0' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER R+foldMapping '\x24C7' = CM '\x24E1' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER S+foldMapping '\x24C8' = CM '\x24E2' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER T+foldMapping '\x24C9' = CM '\x24E3' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER U+foldMapping '\x24CA' = CM '\x24E4' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER V+foldMapping '\x24CB' = CM '\x24E5' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER W+foldMapping '\x24CC' = CM '\x24E6' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER X+foldMapping '\x24CD' = CM '\x24E7' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER Y+foldMapping '\x24CE' = CM '\x24E8' '\0' '\0'+-- CIRCLED LATIN CAPITAL LETTER Z+foldMapping '\x24CF' = CM '\x24E9' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER AZU+foldMapping '\x2C00' = CM '\x2C30' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER BUKY+foldMapping '\x2C01' = CM '\x2C31' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER VEDE+foldMapping '\x2C02' = CM '\x2C32' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER GLAGOLI+foldMapping '\x2C03' = CM '\x2C33' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER DOBRO+foldMapping '\x2C04' = CM '\x2C34' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER YESTU+foldMapping '\x2C05' = CM '\x2C35' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER ZHIVETE+foldMapping '\x2C06' = CM '\x2C36' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER DZELO+foldMapping '\x2C07' = CM '\x2C37' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER ZEMLJA+foldMapping '\x2C08' = CM '\x2C38' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER IZHE+foldMapping '\x2C09' = CM '\x2C39' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER INITIAL IZHE+foldMapping '\x2C0A' = CM '\x2C3A' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER I+foldMapping '\x2C0B' = CM '\x2C3B' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER DJERVI+foldMapping '\x2C0C' = CM '\x2C3C' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER KAKO+foldMapping '\x2C0D' = CM '\x2C3D' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER LJUDIJE+foldMapping '\x2C0E' = CM '\x2C3E' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER MYSLITE+foldMapping '\x2C0F' = CM '\x2C3F' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER NASHI+foldMapping '\x2C10' = CM '\x2C40' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER ONU+foldMapping '\x2C11' = CM '\x2C41' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER POKOJI+foldMapping '\x2C12' = CM '\x2C42' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER RITSI+foldMapping '\x2C13' = CM '\x2C43' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SLOVO+foldMapping '\x2C14' = CM '\x2C44' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER TVRIDO+foldMapping '\x2C15' = CM '\x2C45' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER UKU+foldMapping '\x2C16' = CM '\x2C46' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER FRITU+foldMapping '\x2C17' = CM '\x2C47' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER HERU+foldMapping '\x2C18' = CM '\x2C48' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER OTU+foldMapping '\x2C19' = CM '\x2C49' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER PE+foldMapping '\x2C1A' = CM '\x2C4A' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SHTA+foldMapping '\x2C1B' = CM '\x2C4B' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER TSI+foldMapping '\x2C1C' = CM '\x2C4C' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER CHRIVI+foldMapping '\x2C1D' = CM '\x2C4D' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SHA+foldMapping '\x2C1E' = CM '\x2C4E' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER YERU+foldMapping '\x2C1F' = CM '\x2C4F' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER YERI+foldMapping '\x2C20' = CM '\x2C50' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER YATI+foldMapping '\x2C21' = CM '\x2C51' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SPIDERY HA+foldMapping '\x2C22' = CM '\x2C52' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER YU+foldMapping '\x2C23' = CM '\x2C53' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SMALL YUS+foldMapping '\x2C24' = CM '\x2C54' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SMALL YUS WITH TAIL+foldMapping '\x2C25' = CM '\x2C55' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER YO+foldMapping '\x2C26' = CM '\x2C56' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER IOTATED SMALL YUS+foldMapping '\x2C27' = CM '\x2C57' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER BIG YUS+foldMapping '\x2C28' = CM '\x2C58' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER IOTATED BIG YUS+foldMapping '\x2C29' = CM '\x2C59' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER FITA+foldMapping '\x2C2A' = CM '\x2C5A' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER IZHITSA+foldMapping '\x2C2B' = CM '\x2C5B' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER SHTAPIC+foldMapping '\x2C2C' = CM '\x2C5C' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER TROKUTASTI A+foldMapping '\x2C2D' = CM '\x2C5D' '\0' '\0'+-- GLAGOLITIC CAPITAL LETTER LATINATE MYSLITE+foldMapping '\x2C2E' = CM '\x2C5E' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH DOUBLE BAR+foldMapping '\x2C60' = CM '\x2C61' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH MIDDLE TILDE+foldMapping '\x2C62' = CM '\x026B' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH STROKE+foldMapping '\x2C63' = CM '\x1D7D' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH TAIL+foldMapping '\x2C64' = CM '\x027D' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH DESCENDER+foldMapping '\x2C67' = CM '\x2C68' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH DESCENDER+foldMapping '\x2C69' = CM '\x2C6A' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH DESCENDER+foldMapping '\x2C6B' = CM '\x2C6C' '\0' '\0'+-- LATIN CAPITAL LETTER ALPHA+foldMapping '\x2C6D' = CM '\x0251' '\0' '\0'+-- LATIN CAPITAL LETTER M WITH HOOK+foldMapping '\x2C6E' = CM '\x0271' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED A+foldMapping '\x2C6F' = CM '\x0250' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED ALPHA+foldMapping '\x2C70' = CM '\x0252' '\0' '\0'+-- LATIN CAPITAL LETTER W WITH HOOK+foldMapping '\x2C72' = CM '\x2C73' '\0' '\0'+-- LATIN CAPITAL LETTER HALF H+foldMapping '\x2C75' = CM '\x2C76' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH SWASH TAIL+foldMapping '\x2C7E' = CM '\x023F' '\0' '\0'+-- LATIN CAPITAL LETTER Z WITH SWASH TAIL+foldMapping '\x2C7F' = CM '\x0240' '\0' '\0'+-- COPTIC CAPITAL LETTER ALFA+foldMapping '\x2C80' = CM '\x2C81' '\0' '\0'+-- COPTIC CAPITAL LETTER VIDA+foldMapping '\x2C82' = CM '\x2C83' '\0' '\0'+-- COPTIC CAPITAL LETTER GAMMA+foldMapping '\x2C84' = CM '\x2C85' '\0' '\0'+-- COPTIC CAPITAL LETTER DALDA+foldMapping '\x2C86' = CM '\x2C87' '\0' '\0'+-- COPTIC CAPITAL LETTER EIE+foldMapping '\x2C88' = CM '\x2C89' '\0' '\0'+-- COPTIC CAPITAL LETTER SOU+foldMapping '\x2C8A' = CM '\x2C8B' '\0' '\0'+-- COPTIC CAPITAL LETTER ZATA+foldMapping '\x2C8C' = CM '\x2C8D' '\0' '\0'+-- COPTIC CAPITAL LETTER HATE+foldMapping '\x2C8E' = CM '\x2C8F' '\0' '\0'+-- COPTIC CAPITAL LETTER THETHE+foldMapping '\x2C90' = CM '\x2C91' '\0' '\0'+-- COPTIC CAPITAL LETTER IAUDA+foldMapping '\x2C92' = CM '\x2C93' '\0' '\0'+-- COPTIC CAPITAL LETTER KAPA+foldMapping '\x2C94' = CM '\x2C95' '\0' '\0'+-- COPTIC CAPITAL LETTER LAULA+foldMapping '\x2C96' = CM '\x2C97' '\0' '\0'+-- COPTIC CAPITAL LETTER MI+foldMapping '\x2C98' = CM '\x2C99' '\0' '\0'+-- COPTIC CAPITAL LETTER NI+foldMapping '\x2C9A' = CM '\x2C9B' '\0' '\0'+-- COPTIC CAPITAL LETTER KSI+foldMapping '\x2C9C' = CM '\x2C9D' '\0' '\0'+-- COPTIC CAPITAL LETTER O+foldMapping '\x2C9E' = CM '\x2C9F' '\0' '\0'+-- COPTIC CAPITAL LETTER PI+foldMapping '\x2CA0' = CM '\x2CA1' '\0' '\0'+-- COPTIC CAPITAL LETTER RO+foldMapping '\x2CA2' = CM '\x2CA3' '\0' '\0'+-- COPTIC CAPITAL LETTER SIMA+foldMapping '\x2CA4' = CM '\x2CA5' '\0' '\0'+-- COPTIC CAPITAL LETTER TAU+foldMapping '\x2CA6' = CM '\x2CA7' '\0' '\0'+-- COPTIC CAPITAL LETTER UA+foldMapping '\x2CA8' = CM '\x2CA9' '\0' '\0'+-- COPTIC CAPITAL LETTER FI+foldMapping '\x2CAA' = CM '\x2CAB' '\0' '\0'+-- COPTIC CAPITAL LETTER KHI+foldMapping '\x2CAC' = CM '\x2CAD' '\0' '\0'+-- COPTIC CAPITAL LETTER PSI+foldMapping '\x2CAE' = CM '\x2CAF' '\0' '\0'+-- COPTIC CAPITAL LETTER OOU+foldMapping '\x2CB0' = CM '\x2CB1' '\0' '\0'+-- COPTIC CAPITAL LETTER DIALECT-P ALEF+foldMapping '\x2CB2' = CM '\x2CB3' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC AIN+foldMapping '\x2CB4' = CM '\x2CB5' '\0' '\0'+-- COPTIC CAPITAL LETTER CRYPTOGRAMMIC EIE+foldMapping '\x2CB6' = CM '\x2CB7' '\0' '\0'+-- COPTIC CAPITAL LETTER DIALECT-P KAPA+foldMapping '\x2CB8' = CM '\x2CB9' '\0' '\0'+-- COPTIC CAPITAL LETTER DIALECT-P NI+foldMapping '\x2CBA' = CM '\x2CBB' '\0' '\0'+-- COPTIC CAPITAL LETTER CRYPTOGRAMMIC NI+foldMapping '\x2CBC' = CM '\x2CBD' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC OOU+foldMapping '\x2CBE' = CM '\x2CBF' '\0' '\0'+-- COPTIC CAPITAL LETTER SAMPI+foldMapping '\x2CC0' = CM '\x2CC1' '\0' '\0'+-- COPTIC CAPITAL LETTER CROSSED SHEI+foldMapping '\x2CC2' = CM '\x2CC3' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC SHEI+foldMapping '\x2CC4' = CM '\x2CC5' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC ESH+foldMapping '\x2CC6' = CM '\x2CC7' '\0' '\0'+-- COPTIC CAPITAL LETTER AKHMIMIC KHEI+foldMapping '\x2CC8' = CM '\x2CC9' '\0' '\0'+-- COPTIC CAPITAL LETTER DIALECT-P HORI+foldMapping '\x2CCA' = CM '\x2CCB' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC HORI+foldMapping '\x2CCC' = CM '\x2CCD' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC HA+foldMapping '\x2CCE' = CM '\x2CCF' '\0' '\0'+-- COPTIC CAPITAL LETTER L-SHAPED HA+foldMapping '\x2CD0' = CM '\x2CD1' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC HEI+foldMapping '\x2CD2' = CM '\x2CD3' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC HAT+foldMapping '\x2CD4' = CM '\x2CD5' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC GANGIA+foldMapping '\x2CD6' = CM '\x2CD7' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC DJA+foldMapping '\x2CD8' = CM '\x2CD9' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD COPTIC SHIMA+foldMapping '\x2CDA' = CM '\x2CDB' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD NUBIAN SHIMA+foldMapping '\x2CDC' = CM '\x2CDD' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD NUBIAN NGI+foldMapping '\x2CDE' = CM '\x2CDF' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD NUBIAN NYI+foldMapping '\x2CE0' = CM '\x2CE1' '\0' '\0'+-- COPTIC CAPITAL LETTER OLD NUBIAN WAU+foldMapping '\x2CE2' = CM '\x2CE3' '\0' '\0'+-- COPTIC CAPITAL LETTER CRYPTOGRAMMIC SHEI+foldMapping '\x2CEB' = CM '\x2CEC' '\0' '\0'+-- COPTIC CAPITAL LETTER CRYPTOGRAMMIC GANGIA+foldMapping '\x2CED' = CM '\x2CEE' '\0' '\0'+-- COPTIC CAPITAL LETTER BOHAIRIC KHEI+foldMapping '\x2CF2' = CM '\x2CF3' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZEMLYA+foldMapping '\xA640' = CM '\xA641' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DZELO+foldMapping '\xA642' = CM '\xA643' '\0' '\0'+-- CYRILLIC CAPITAL LETTER REVERSED DZE+foldMapping '\xA644' = CM '\xA645' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTA+foldMapping '\xA646' = CM '\xA647' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DJERV+foldMapping '\xA648' = CM '\xA649' '\0' '\0'+-- CYRILLIC CAPITAL LETTER MONOGRAPH UK+foldMapping '\xA64A' = CM '\xA64B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BROAD OMEGA+foldMapping '\xA64C' = CM '\xA64D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER NEUTRAL YER+foldMapping '\xA64E' = CM '\xA64F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YERU WITH BACK YER+foldMapping '\xA650' = CM '\xA651' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTIFIED YAT+foldMapping '\xA652' = CM '\xA653' '\0' '\0'+-- CYRILLIC CAPITAL LETTER REVERSED YU+foldMapping '\xA654' = CM '\xA655' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTIFIED A+foldMapping '\xA656' = CM '\xA657' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CLOSED LITTLE YUS+foldMapping '\xA658' = CM '\xA659' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BLENDED YUS+foldMapping '\xA65A' = CM '\xA65B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER IOTIFIED CLOSED LITTLE YUS+foldMapping '\xA65C' = CM '\xA65D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER YN+foldMapping '\xA65E' = CM '\xA65F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER REVERSED TSE+foldMapping '\xA660' = CM '\xA661' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SOFT DE+foldMapping '\xA662' = CM '\xA663' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SOFT EL+foldMapping '\xA664' = CM '\xA665' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SOFT EM+foldMapping '\xA666' = CM '\xA667' '\0' '\0'+-- CYRILLIC CAPITAL LETTER MONOCULAR O+foldMapping '\xA668' = CM '\xA669' '\0' '\0'+-- CYRILLIC CAPITAL LETTER BINOCULAR O+foldMapping '\xA66A' = CM '\xA66B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DOUBLE MONOCULAR O+foldMapping '\xA66C' = CM '\xA66D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DWE+foldMapping '\xA680' = CM '\xA681' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DZWE+foldMapping '\xA682' = CM '\xA683' '\0' '\0'+-- CYRILLIC CAPITAL LETTER ZHWE+foldMapping '\xA684' = CM '\xA685' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CCHE+foldMapping '\xA686' = CM '\xA687' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DZZE+foldMapping '\xA688' = CM '\xA689' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TE WITH MIDDLE HOOK+foldMapping '\xA68A' = CM '\xA68B' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TWE+foldMapping '\xA68C' = CM '\xA68D' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TSWE+foldMapping '\xA68E' = CM '\xA68F' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TSSE+foldMapping '\xA690' = CM '\xA691' '\0' '\0'+-- CYRILLIC CAPITAL LETTER TCHE+foldMapping '\xA692' = CM '\xA693' '\0' '\0'+-- CYRILLIC CAPITAL LETTER HWE+foldMapping '\xA694' = CM '\xA695' '\0' '\0'+-- CYRILLIC CAPITAL LETTER SHWE+foldMapping '\xA696' = CM '\xA697' '\0' '\0'+-- CYRILLIC CAPITAL LETTER DOUBLE O+foldMapping '\xA698' = CM '\xA699' '\0' '\0'+-- CYRILLIC CAPITAL LETTER CROSSED O+foldMapping '\xA69A' = CM '\xA69B' '\0' '\0'+-- LATIN CAPITAL LETTER EGYPTOLOGICAL ALEF+foldMapping '\xA722' = CM '\xA723' '\0' '\0'+-- LATIN CAPITAL LETTER EGYPTOLOGICAL AIN+foldMapping '\xA724' = CM '\xA725' '\0' '\0'+-- LATIN CAPITAL LETTER HENG+foldMapping '\xA726' = CM '\xA727' '\0' '\0'+-- LATIN CAPITAL LETTER TZ+foldMapping '\xA728' = CM '\xA729' '\0' '\0'+-- LATIN CAPITAL LETTER TRESILLO+foldMapping '\xA72A' = CM '\xA72B' '\0' '\0'+-- LATIN CAPITAL LETTER CUATRILLO+foldMapping '\xA72C' = CM '\xA72D' '\0' '\0'+-- LATIN CAPITAL LETTER CUATRILLO WITH COMMA+foldMapping '\xA72E' = CM '\xA72F' '\0' '\0'+-- LATIN CAPITAL LETTER AA+foldMapping '\xA732' = CM '\xA733' '\0' '\0'+-- LATIN CAPITAL LETTER AO+foldMapping '\xA734' = CM '\xA735' '\0' '\0'+-- LATIN CAPITAL LETTER AU+foldMapping '\xA736' = CM '\xA737' '\0' '\0'+-- LATIN CAPITAL LETTER AV+foldMapping '\xA738' = CM '\xA739' '\0' '\0'+-- LATIN CAPITAL LETTER AV WITH HORIZONTAL BAR+foldMapping '\xA73A' = CM '\xA73B' '\0' '\0'+-- LATIN CAPITAL LETTER AY+foldMapping '\xA73C' = CM '\xA73D' '\0' '\0'+-- LATIN CAPITAL LETTER REVERSED C WITH DOT+foldMapping '\xA73E' = CM '\xA73F' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH STROKE+foldMapping '\xA740' = CM '\xA741' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH DIAGONAL STROKE+foldMapping '\xA742' = CM '\xA743' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH STROKE AND DIAGONAL STROKE+foldMapping '\xA744' = CM '\xA745' '\0' '\0'+-- LATIN CAPITAL LETTER BROKEN L+foldMapping '\xA746' = CM '\xA747' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH HIGH STROKE+foldMapping '\xA748' = CM '\xA749' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH LONG STROKE OVERLAY+foldMapping '\xA74A' = CM '\xA74B' '\0' '\0'+-- LATIN CAPITAL LETTER O WITH LOOP+foldMapping '\xA74C' = CM '\xA74D' '\0' '\0'+-- LATIN CAPITAL LETTER OO+foldMapping '\xA74E' = CM '\xA74F' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH STROKE THROUGH DESCENDER+foldMapping '\xA750' = CM '\xA751' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH FLOURISH+foldMapping '\xA752' = CM '\xA753' '\0' '\0'+-- LATIN CAPITAL LETTER P WITH SQUIRREL TAIL+foldMapping '\xA754' = CM '\xA755' '\0' '\0'+-- LATIN CAPITAL LETTER Q WITH STROKE THROUGH DESCENDER+foldMapping '\xA756' = CM '\xA757' '\0' '\0'+-- LATIN CAPITAL LETTER Q WITH DIAGONAL STROKE+foldMapping '\xA758' = CM '\xA759' '\0' '\0'+-- LATIN CAPITAL LETTER R ROTUNDA+foldMapping '\xA75A' = CM '\xA75B' '\0' '\0'+-- LATIN CAPITAL LETTER RUM ROTUNDA+foldMapping '\xA75C' = CM '\xA75D' '\0' '\0'+-- LATIN CAPITAL LETTER V WITH DIAGONAL STROKE+foldMapping '\xA75E' = CM '\xA75F' '\0' '\0'+-- LATIN CAPITAL LETTER VY+foldMapping '\xA760' = CM '\xA761' '\0' '\0'+-- LATIN CAPITAL LETTER VISIGOTHIC Z+foldMapping '\xA762' = CM '\xA763' '\0' '\0'+-- LATIN CAPITAL LETTER THORN WITH STROKE+foldMapping '\xA764' = CM '\xA765' '\0' '\0'+-- LATIN CAPITAL LETTER THORN WITH STROKE THROUGH DESCENDER+foldMapping '\xA766' = CM '\xA767' '\0' '\0'+-- LATIN CAPITAL LETTER VEND+foldMapping '\xA768' = CM '\xA769' '\0' '\0'+-- LATIN CAPITAL LETTER ET+foldMapping '\xA76A' = CM '\xA76B' '\0' '\0'+-- LATIN CAPITAL LETTER IS+foldMapping '\xA76C' = CM '\xA76D' '\0' '\0'+-- LATIN CAPITAL LETTER CON+foldMapping '\xA76E' = CM '\xA76F' '\0' '\0'+-- LATIN CAPITAL LETTER INSULAR D+foldMapping '\xA779' = CM '\xA77A' '\0' '\0'+-- LATIN CAPITAL LETTER INSULAR F+foldMapping '\xA77B' = CM '\xA77C' '\0' '\0'+-- LATIN CAPITAL LETTER INSULAR G+foldMapping '\xA77D' = CM '\x1D79' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED INSULAR G+foldMapping '\xA77E' = CM '\xA77F' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED L+foldMapping '\xA780' = CM '\xA781' '\0' '\0'+-- LATIN CAPITAL LETTER INSULAR R+foldMapping '\xA782' = CM '\xA783' '\0' '\0'+-- LATIN CAPITAL LETTER INSULAR S+foldMapping '\xA784' = CM '\xA785' '\0' '\0'+-- LATIN CAPITAL LETTER INSULAR T+foldMapping '\xA786' = CM '\xA787' '\0' '\0'+-- LATIN CAPITAL LETTER SALTILLO+foldMapping '\xA78B' = CM '\xA78C' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED H+foldMapping '\xA78D' = CM '\x0265' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH DESCENDER+foldMapping '\xA790' = CM '\xA791' '\0' '\0'+-- LATIN CAPITAL LETTER C WITH BAR+foldMapping '\xA792' = CM '\xA793' '\0' '\0'+-- LATIN CAPITAL LETTER B WITH FLOURISH+foldMapping '\xA796' = CM '\xA797' '\0' '\0'+-- LATIN CAPITAL LETTER F WITH STROKE+foldMapping '\xA798' = CM '\xA799' '\0' '\0'+-- LATIN CAPITAL LETTER VOLAPUK AE+foldMapping '\xA79A' = CM '\xA79B' '\0' '\0'+-- LATIN CAPITAL LETTER VOLAPUK OE+foldMapping '\xA79C' = CM '\xA79D' '\0' '\0'+-- LATIN CAPITAL LETTER VOLAPUK UE+foldMapping '\xA79E' = CM '\xA79F' '\0' '\0'+-- LATIN CAPITAL LETTER G WITH OBLIQUE STROKE+foldMapping '\xA7A0' = CM '\xA7A1' '\0' '\0'+-- LATIN CAPITAL LETTER K WITH OBLIQUE STROKE+foldMapping '\xA7A2' = CM '\xA7A3' '\0' '\0'+-- LATIN CAPITAL LETTER N WITH OBLIQUE STROKE+foldMapping '\xA7A4' = CM '\xA7A5' '\0' '\0'+-- LATIN CAPITAL LETTER R WITH OBLIQUE STROKE+foldMapping '\xA7A6' = CM '\xA7A7' '\0' '\0'+-- LATIN CAPITAL LETTER S WITH OBLIQUE STROKE+foldMapping '\xA7A8' = CM '\xA7A9' '\0' '\0'+-- LATIN CAPITAL LETTER H WITH HOOK+foldMapping '\xA7AA' = CM '\x0266' '\0' '\0'+-- LATIN CAPITAL LETTER REVERSED OPEN E+foldMapping '\xA7AB' = CM '\x025C' '\0' '\0'+-- LATIN CAPITAL LETTER SCRIPT G+foldMapping '\xA7AC' = CM '\x0261' '\0' '\0'+-- LATIN CAPITAL LETTER L WITH BELT+foldMapping '\xA7AD' = CM '\x026C' '\0' '\0'+-- LATIN CAPITAL LETTER SMALL CAPITAL I+foldMapping '\xA7AE' = CM '\x026A' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED K+foldMapping '\xA7B0' = CM '\x029E' '\0' '\0'+-- LATIN CAPITAL LETTER TURNED T+foldMapping '\xA7B1' = CM '\x0287' '\0' '\0'+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL+foldMapping '\xA7B2' = CM '\x029D' '\0' '\0'+-- LATIN CAPITAL LETTER CHI+foldMapping '\xA7B3' = CM '\xAB53' '\0' '\0'+-- LATIN CAPITAL LETTER BETA+foldMapping '\xA7B4' = CM '\xA7B5' '\0' '\0'+-- LATIN CAPITAL LETTER OMEGA+foldMapping '\xA7B6' = CM '\xA7B7' '\0' '\0'+-- CHEROKEE SMALL LETTER A+foldMapping '\xAB70' = CM '\x13A0' '\0' '\0'+-- CHEROKEE SMALL LETTER E+foldMapping '\xAB71' = CM '\x13A1' '\0' '\0'+-- CHEROKEE SMALL LETTER I+foldMapping '\xAB72' = CM '\x13A2' '\0' '\0'+-- CHEROKEE SMALL LETTER O+foldMapping '\xAB73' = CM '\x13A3' '\0' '\0'+-- CHEROKEE SMALL LETTER U+foldMapping '\xAB74' = CM '\x13A4' '\0' '\0'+-- CHEROKEE SMALL LETTER V+foldMapping '\xAB75' = CM '\x13A5' '\0' '\0'+-- CHEROKEE SMALL LETTER GA+foldMapping '\xAB76' = CM '\x13A6' '\0' '\0'+-- CHEROKEE SMALL LETTER KA+foldMapping '\xAB77' = CM '\x13A7' '\0' '\0'+-- CHEROKEE SMALL LETTER GE+foldMapping '\xAB78' = CM '\x13A8' '\0' '\0'+-- CHEROKEE SMALL LETTER GI+foldMapping '\xAB79' = CM '\x13A9' '\0' '\0'+-- CHEROKEE SMALL LETTER GO+foldMapping '\xAB7A' = CM '\x13AA' '\0' '\0'+-- CHEROKEE SMALL LETTER GU+foldMapping '\xAB7B' = CM '\x13AB' '\0' '\0'+-- CHEROKEE SMALL LETTER GV+foldMapping '\xAB7C' = CM '\x13AC' '\0' '\0'+-- CHEROKEE SMALL LETTER HA+foldMapping '\xAB7D' = CM '\x13AD' '\0' '\0'+-- CHEROKEE SMALL LETTER HE+foldMapping '\xAB7E' = CM '\x13AE' '\0' '\0'+-- CHEROKEE SMALL LETTER HI+foldMapping '\xAB7F' = CM '\x13AF' '\0' '\0'+-- CHEROKEE SMALL LETTER HO+foldMapping '\xAB80' = CM '\x13B0' '\0' '\0'+-- CHEROKEE SMALL LETTER HU+foldMapping '\xAB81' = CM '\x13B1' '\0' '\0'+-- CHEROKEE SMALL LETTER HV+foldMapping '\xAB82' = CM '\x13B2' '\0' '\0'+-- CHEROKEE SMALL LETTER LA+foldMapping '\xAB83' = CM '\x13B3' '\0' '\0'+-- CHEROKEE SMALL LETTER LE+foldMapping '\xAB84' = CM '\x13B4' '\0' '\0'+-- CHEROKEE SMALL LETTER LI+foldMapping '\xAB85' = CM '\x13B5' '\0' '\0'+-- CHEROKEE SMALL LETTER LO+foldMapping '\xAB86' = CM '\x13B6' '\0' '\0'+-- CHEROKEE SMALL LETTER LU+foldMapping '\xAB87' = CM '\x13B7' '\0' '\0'+-- CHEROKEE SMALL LETTER LV+foldMapping '\xAB88' = CM '\x13B8' '\0' '\0'+-- CHEROKEE SMALL LETTER MA+foldMapping '\xAB89' = CM '\x13B9' '\0' '\0'+-- CHEROKEE SMALL LETTER ME+foldMapping '\xAB8A' = CM '\x13BA' '\0' '\0'+-- CHEROKEE SMALL LETTER MI+foldMapping '\xAB8B' = CM '\x13BB' '\0' '\0'+-- CHEROKEE SMALL LETTER MO+foldMapping '\xAB8C' = CM '\x13BC' '\0' '\0'+-- CHEROKEE SMALL LETTER MU+foldMapping '\xAB8D' = CM '\x13BD' '\0' '\0'+-- CHEROKEE SMALL LETTER NA+foldMapping '\xAB8E' = CM '\x13BE' '\0' '\0'+-- CHEROKEE SMALL LETTER HNA+foldMapping '\xAB8F' = CM '\x13BF' '\0' '\0'+-- CHEROKEE SMALL LETTER NAH+foldMapping '\xAB90' = CM '\x13C0' '\0' '\0'+-- CHEROKEE SMALL LETTER NE+foldMapping '\xAB91' = CM '\x13C1' '\0' '\0'+-- CHEROKEE SMALL LETTER NI+foldMapping '\xAB92' = CM '\x13C2' '\0' '\0'+-- CHEROKEE SMALL LETTER NO+foldMapping '\xAB93' = CM '\x13C3' '\0' '\0'+-- CHEROKEE SMALL LETTER NU+foldMapping '\xAB94' = CM '\x13C4' '\0' '\0'+-- CHEROKEE SMALL LETTER NV+foldMapping '\xAB95' = CM '\x13C5' '\0' '\0'+-- CHEROKEE SMALL LETTER QUA+foldMapping '\xAB96' = CM '\x13C6' '\0' '\0'+-- CHEROKEE SMALL LETTER QUE+foldMapping '\xAB97' = CM '\x13C7' '\0' '\0'+-- CHEROKEE SMALL LETTER QUI+foldMapping '\xAB98' = CM '\x13C8' '\0' '\0'+-- CHEROKEE SMALL LETTER QUO+foldMapping '\xAB99' = CM '\x13C9' '\0' '\0'+-- CHEROKEE SMALL LETTER QUU+foldMapping '\xAB9A' = CM '\x13CA' '\0' '\0'+-- CHEROKEE SMALL LETTER QUV+foldMapping '\xAB9B' = CM '\x13CB' '\0' '\0'+-- CHEROKEE SMALL LETTER SA+foldMapping '\xAB9C' = CM '\x13CC' '\0' '\0'+-- CHEROKEE SMALL LETTER S+foldMapping '\xAB9D' = CM '\x13CD' '\0' '\0'+-- CHEROKEE SMALL LETTER SE+foldMapping '\xAB9E' = CM '\x13CE' '\0' '\0'+-- CHEROKEE SMALL LETTER SI+foldMapping '\xAB9F' = CM '\x13CF' '\0' '\0'+-- CHEROKEE SMALL LETTER SO+foldMapping '\xABA0' = CM '\x13D0' '\0' '\0'+-- CHEROKEE SMALL LETTER SU+foldMapping '\xABA1' = CM '\x13D1' '\0' '\0'+-- CHEROKEE SMALL LETTER SV+foldMapping '\xABA2' = CM '\x13D2' '\0' '\0'+-- CHEROKEE SMALL LETTER DA+foldMapping '\xABA3' = CM '\x13D3' '\0' '\0'+-- CHEROKEE SMALL LETTER TA+foldMapping '\xABA4' = CM '\x13D4' '\0' '\0'+-- CHEROKEE SMALL LETTER DE+foldMapping '\xABA5' = CM '\x13D5' '\0' '\0'+-- CHEROKEE SMALL LETTER TE+foldMapping '\xABA6' = CM '\x13D6' '\0' '\0'+-- CHEROKEE SMALL LETTER DI+foldMapping '\xABA7' = CM '\x13D7' '\0' '\0'+-- CHEROKEE SMALL LETTER TI+foldMapping '\xABA8' = CM '\x13D8' '\0' '\0'+-- CHEROKEE SMALL LETTER DO+foldMapping '\xABA9' = CM '\x13D9' '\0' '\0'+-- CHEROKEE SMALL LETTER DU+foldMapping '\xABAA' = CM '\x13DA' '\0' '\0'+-- CHEROKEE SMALL LETTER DV+foldMapping '\xABAB' = CM '\x13DB' '\0' '\0'+-- CHEROKEE SMALL LETTER DLA+foldMapping '\xABAC' = CM '\x13DC' '\0' '\0'+-- CHEROKEE SMALL LETTER TLA+foldMapping '\xABAD' = CM '\x13DD' '\0' '\0'+-- CHEROKEE SMALL LETTER TLE+foldMapping '\xABAE' = CM '\x13DE' '\0' '\0'+-- CHEROKEE SMALL LETTER TLI+foldMapping '\xABAF' = CM '\x13DF' '\0' '\0'+-- CHEROKEE SMALL LETTER TLO+foldMapping '\xABB0' = CM '\x13E0' '\0' '\0'+-- CHEROKEE SMALL LETTER TLU+foldMapping '\xABB1' = CM '\x13E1' '\0' '\0'+-- CHEROKEE SMALL LETTER TLV+foldMapping '\xABB2' = CM '\x13E2' '\0' '\0'+-- CHEROKEE SMALL LETTER TSA+foldMapping '\xABB3' = CM '\x13E3' '\0' '\0'+-- CHEROKEE SMALL LETTER TSE+foldMapping '\xABB4' = CM '\x13E4' '\0' '\0'+-- CHEROKEE SMALL LETTER TSI+foldMapping '\xABB5' = CM '\x13E5' '\0' '\0'+-- CHEROKEE SMALL LETTER TSO+foldMapping '\xABB6' = CM '\x13E6' '\0' '\0'+-- CHEROKEE SMALL LETTER TSU+foldMapping '\xABB7' = CM '\x13E7' '\0' '\0'+-- CHEROKEE SMALL LETTER TSV+foldMapping '\xABB8' = CM '\x13E8' '\0' '\0'+-- CHEROKEE SMALL LETTER WA+foldMapping '\xABB9' = CM '\x13E9' '\0' '\0'+-- CHEROKEE SMALL LETTER WE+foldMapping '\xABBA' = CM '\x13EA' '\0' '\0'+-- CHEROKEE SMALL LETTER WI+foldMapping '\xABBB' = CM '\x13EB' '\0' '\0'+-- CHEROKEE SMALL LETTER WO+foldMapping '\xABBC' = CM '\x13EC' '\0' '\0'+-- CHEROKEE SMALL LETTER WU+foldMapping '\xABBD' = CM '\x13ED' '\0' '\0'+-- CHEROKEE SMALL LETTER WV+foldMapping '\xABBE' = CM '\x13EE' '\0' '\0'+-- CHEROKEE SMALL LETTER YA+foldMapping '\xABBF' = CM '\x13EF' '\0' '\0'+-- LATIN SMALL LIGATURE FF+foldMapping '\xFB00' = CM '\x0066' '\x0066' '\0'+-- LATIN SMALL LIGATURE FI+foldMapping '\xFB01' = CM '\x0066' '\x0069' '\0'+-- LATIN SMALL LIGATURE FL+foldMapping '\xFB02' = CM '\x0066' '\x006C' '\0'+-- LATIN SMALL LIGATURE FFI+foldMapping '\xFB03' = CM '\x0066' '\x0066' '\x0069'+-- LATIN SMALL LIGATURE FFL+foldMapping '\xFB04' = CM '\x0066' '\x0066' '\x006C'+-- LATIN SMALL LIGATURE LONG S T+foldMapping '\xFB05' = CM '\x0073' '\x0074' '\0'+-- LATIN SMALL LIGATURE ST+foldMapping '\xFB06' = CM '\x0073' '\x0074' '\0'+-- ARMENIAN SMALL LIGATURE MEN NOW+foldMapping '\xFB13' = CM '\x0574' '\x0576' '\0'+-- ARMENIAN SMALL LIGATURE MEN ECH+foldMapping '\xFB14' = CM '\x0574' '\x0565' '\0'+-- ARMENIAN SMALL LIGATURE MEN INI+foldMapping '\xFB15' = CM '\x0574' '\x056B' '\0'+-- ARMENIAN SMALL LIGATURE VEW NOW+foldMapping '\xFB16' = CM '\x057E' '\x0576' '\0'+-- ARMENIAN SMALL LIGATURE MEN XEH+foldMapping '\xFB17' = CM '\x0574' '\x056D' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER A+foldMapping '\xFF21' = CM '\xFF41' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER B+foldMapping '\xFF22' = CM '\xFF42' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER C+foldMapping '\xFF23' = CM '\xFF43' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER D+foldMapping '\xFF24' = CM '\xFF44' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER E+foldMapping '\xFF25' = CM '\xFF45' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER F+foldMapping '\xFF26' = CM '\xFF46' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER G+foldMapping '\xFF27' = CM '\xFF47' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER H+foldMapping '\xFF28' = CM '\xFF48' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER I+foldMapping '\xFF29' = CM '\xFF49' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER J+foldMapping '\xFF2A' = CM '\xFF4A' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER K+foldMapping '\xFF2B' = CM '\xFF4B' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER L+foldMapping '\xFF2C' = CM '\xFF4C' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER M+foldMapping '\xFF2D' = CM '\xFF4D' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER N+foldMapping '\xFF2E' = CM '\xFF4E' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER O+foldMapping '\xFF2F' = CM '\xFF4F' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER P+foldMapping '\xFF30' = CM '\xFF50' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER Q+foldMapping '\xFF31' = CM '\xFF51' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER R+foldMapping '\xFF32' = CM '\xFF52' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER S+foldMapping '\xFF33' = CM '\xFF53' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER T+foldMapping '\xFF34' = CM '\xFF54' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER U+foldMapping '\xFF35' = CM '\xFF55' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER V+foldMapping '\xFF36' = CM '\xFF56' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER W+foldMapping '\xFF37' = CM '\xFF57' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER X+foldMapping '\xFF38' = CM '\xFF58' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER Y+foldMapping '\xFF39' = CM '\xFF59' '\0' '\0'+-- FULLWIDTH LATIN CAPITAL LETTER Z+foldMapping '\xFF3A' = CM '\xFF5A' '\0' '\0'+-- DESERET CAPITAL LETTER LONG I+foldMapping '\x10400' = CM '\x10428' '\0' '\0'+-- DESERET CAPITAL LETTER LONG E+foldMapping '\x10401' = CM '\x10429' '\0' '\0'+-- DESERET CAPITAL LETTER LONG A+foldMapping '\x10402' = CM '\x1042A' '\0' '\0'+-- DESERET CAPITAL LETTER LONG AH+foldMapping '\x10403' = CM '\x1042B' '\0' '\0'+-- DESERET CAPITAL LETTER LONG O+foldMapping '\x10404' = CM '\x1042C' '\0' '\0'+-- DESERET CAPITAL LETTER LONG OO+foldMapping '\x10405' = CM '\x1042D' '\0' '\0'+-- DESERET CAPITAL LETTER SHORT I+foldMapping '\x10406' = CM '\x1042E' '\0' '\0'+-- DESERET CAPITAL LETTER SHORT E+foldMapping '\x10407' = CM '\x1042F' '\0' '\0'+-- DESERET CAPITAL LETTER SHORT A+foldMapping '\x10408' = CM '\x10430' '\0' '\0'+-- DESERET CAPITAL LETTER SHORT AH+foldMapping '\x10409' = CM '\x10431' '\0' '\0'+-- DESERET CAPITAL LETTER SHORT O+foldMapping '\x1040A' = CM '\x10432' '\0' '\0'+-- DESERET CAPITAL LETTER SHORT OO+foldMapping '\x1040B' = CM '\x10433' '\0' '\0'+-- DESERET CAPITAL LETTER AY+foldMapping '\x1040C' = CM '\x10434' '\0' '\0'+-- DESERET CAPITAL LETTER OW+foldMapping '\x1040D' = CM '\x10435' '\0' '\0'+-- DESERET CAPITAL LETTER WU+foldMapping '\x1040E' = CM '\x10436' '\0' '\0'+-- DESERET CAPITAL LETTER YEE+foldMapping '\x1040F' = CM '\x10437' '\0' '\0'+-- DESERET CAPITAL LETTER H+foldMapping '\x10410' = CM '\x10438' '\0' '\0'+-- DESERET CAPITAL LETTER PEE+foldMapping '\x10411' = CM '\x10439' '\0' '\0'+-- DESERET CAPITAL LETTER BEE+foldMapping '\x10412' = CM '\x1043A' '\0' '\0'+-- DESERET CAPITAL LETTER TEE+foldMapping '\x10413' = CM '\x1043B' '\0' '\0'+-- DESERET CAPITAL LETTER DEE+foldMapping '\x10414' = CM '\x1043C' '\0' '\0'+-- DESERET CAPITAL LETTER CHEE+foldMapping '\x10415' = CM '\x1043D' '\0' '\0'+-- DESERET CAPITAL LETTER JEE+foldMapping '\x10416' = CM '\x1043E' '\0' '\0'+-- DESERET CAPITAL LETTER KAY+foldMapping '\x10417' = CM '\x1043F' '\0' '\0'+-- DESERET CAPITAL LETTER GAY+foldMapping '\x10418' = CM '\x10440' '\0' '\0'+-- DESERET CAPITAL LETTER EF+foldMapping '\x10419' = CM '\x10441' '\0' '\0'+-- DESERET CAPITAL LETTER VEE+foldMapping '\x1041A' = CM '\x10442' '\0' '\0'+-- DESERET CAPITAL LETTER ETH+foldMapping '\x1041B' = CM '\x10443' '\0' '\0'+-- DESERET CAPITAL LETTER THEE+foldMapping '\x1041C' = CM '\x10444' '\0' '\0'+-- DESERET CAPITAL LETTER ES+foldMapping '\x1041D' = CM '\x10445' '\0' '\0'+-- DESERET CAPITAL LETTER ZEE+foldMapping '\x1041E' = CM '\x10446' '\0' '\0'+-- DESERET CAPITAL LETTER ESH+foldMapping '\x1041F' = CM '\x10447' '\0' '\0'+-- DESERET CAPITAL LETTER ZHEE+foldMapping '\x10420' = CM '\x10448' '\0' '\0'+-- DESERET CAPITAL LETTER ER+foldMapping '\x10421' = CM '\x10449' '\0' '\0'+-- DESERET CAPITAL LETTER EL+foldMapping '\x10422' = CM '\x1044A' '\0' '\0'+-- DESERET CAPITAL LETTER EM+foldMapping '\x10423' = CM '\x1044B' '\0' '\0'+-- DESERET CAPITAL LETTER EN+foldMapping '\x10424' = CM '\x1044C' '\0' '\0'+-- DESERET CAPITAL LETTER ENG+foldMapping '\x10425' = CM '\x1044D' '\0' '\0'+-- DESERET CAPITAL LETTER OI+foldMapping '\x10426' = CM '\x1044E' '\0' '\0'+-- DESERET CAPITAL LETTER EW+foldMapping '\x10427' = CM '\x1044F' '\0' '\0'+-- OSAGE CAPITAL LETTER A+foldMapping '\x104B0' = CM '\x104D8' '\0' '\0'+-- OSAGE CAPITAL LETTER AI+foldMapping '\x104B1' = CM '\x104D9' '\0' '\0'+-- OSAGE CAPITAL LETTER AIN+foldMapping '\x104B2' = CM '\x104DA' '\0' '\0'+-- OSAGE CAPITAL LETTER AH+foldMapping '\x104B3' = CM '\x104DB' '\0' '\0'+-- OSAGE CAPITAL LETTER BRA+foldMapping '\x104B4' = CM '\x104DC' '\0' '\0'+-- OSAGE CAPITAL LETTER CHA+foldMapping '\x104B5' = CM '\x104DD' '\0' '\0'+-- OSAGE CAPITAL LETTER EHCHA+foldMapping '\x104B6' = CM '\x104DE' '\0' '\0'+-- OSAGE CAPITAL LETTER E+foldMapping '\x104B7' = CM '\x104DF' '\0' '\0'+-- OSAGE CAPITAL LETTER EIN+foldMapping '\x104B8' = CM '\x104E0' '\0' '\0'+-- OSAGE CAPITAL LETTER HA+foldMapping '\x104B9' = CM '\x104E1' '\0' '\0'+-- OSAGE CAPITAL LETTER HYA+foldMapping '\x104BA' = CM '\x104E2' '\0' '\0'+-- OSAGE CAPITAL LETTER I+foldMapping '\x104BB' = CM '\x104E3' '\0' '\0'+-- OSAGE CAPITAL LETTER KA+foldMapping '\x104BC' = CM '\x104E4' '\0' '\0'+-- OSAGE CAPITAL LETTER EHKA+foldMapping '\x104BD' = CM '\x104E5' '\0' '\0'+-- OSAGE CAPITAL LETTER KYA+foldMapping '\x104BE' = CM '\x104E6' '\0' '\0'+-- OSAGE CAPITAL LETTER LA+foldMapping '\x104BF' = CM '\x104E7' '\0' '\0'+-- OSAGE CAPITAL LETTER MA+foldMapping '\x104C0' = CM '\x104E8' '\0' '\0'+-- OSAGE CAPITAL LETTER NA+foldMapping '\x104C1' = CM '\x104E9' '\0' '\0'+-- OSAGE CAPITAL LETTER O+foldMapping '\x104C2' = CM '\x104EA' '\0' '\0'+-- OSAGE CAPITAL LETTER OIN+foldMapping '\x104C3' = CM '\x104EB' '\0' '\0'+-- OSAGE CAPITAL LETTER PA+foldMapping '\x104C4' = CM '\x104EC' '\0' '\0'+-- OSAGE CAPITAL LETTER EHPA+foldMapping '\x104C5' = CM '\x104ED' '\0' '\0'+-- OSAGE CAPITAL LETTER SA+foldMapping '\x104C6' = CM '\x104EE' '\0' '\0'+-- OSAGE CAPITAL LETTER SHA+foldMapping '\x104C7' = CM '\x104EF' '\0' '\0'+-- OSAGE CAPITAL LETTER TA+foldMapping '\x104C8' = CM '\x104F0' '\0' '\0'+-- OSAGE CAPITAL LETTER EHTA+foldMapping '\x104C9' = CM '\x104F1' '\0' '\0'+-- OSAGE CAPITAL LETTER TSA+foldMapping '\x104CA' = CM '\x104F2' '\0' '\0'+-- OSAGE CAPITAL LETTER EHTSA+foldMapping '\x104CB' = CM '\x104F3' '\0' '\0'+-- OSAGE CAPITAL LETTER TSHA+foldMapping '\x104CC' = CM '\x104F4' '\0' '\0'+-- OSAGE CAPITAL LETTER DHA+foldMapping '\x104CD' = CM '\x104F5' '\0' '\0'+-- OSAGE CAPITAL LETTER U+foldMapping '\x104CE' = CM '\x104F6' '\0' '\0'+-- OSAGE CAPITAL LETTER WA+foldMapping '\x104CF' = CM '\x104F7' '\0' '\0'+-- OSAGE CAPITAL LETTER KHA+foldMapping '\x104D0' = CM '\x104F8' '\0' '\0'+-- OSAGE CAPITAL LETTER GHA+foldMapping '\x104D1' = CM '\x104F9' '\0' '\0'+-- OSAGE CAPITAL LETTER ZA+foldMapping '\x104D2' = CM '\x104FA' '\0' '\0'+-- OSAGE CAPITAL LETTER ZHA+foldMapping '\x104D3' = CM '\x104FB' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER A+foldMapping '\x10C80' = CM '\x10CC0' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER AA+foldMapping '\x10C81' = CM '\x10CC1' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EB+foldMapping '\x10C82' = CM '\x10CC2' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER AMB+foldMapping '\x10C83' = CM '\x10CC3' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EC+foldMapping '\x10C84' = CM '\x10CC4' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ENC+foldMapping '\x10C85' = CM '\x10CC5' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ECS+foldMapping '\x10C86' = CM '\x10CC6' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ED+foldMapping '\x10C87' = CM '\x10CC7' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER AND+foldMapping '\x10C88' = CM '\x10CC8' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER E+foldMapping '\x10C89' = CM '\x10CC9' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER CLOSE E+foldMapping '\x10C8A' = CM '\x10CCA' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EE+foldMapping '\x10C8B' = CM '\x10CCB' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EF+foldMapping '\x10C8C' = CM '\x10CCC' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EG+foldMapping '\x10C8D' = CM '\x10CCD' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EGY+foldMapping '\x10C8E' = CM '\x10CCE' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EH+foldMapping '\x10C8F' = CM '\x10CCF' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER I+foldMapping '\x10C90' = CM '\x10CD0' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER II+foldMapping '\x10C91' = CM '\x10CD1' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EJ+foldMapping '\x10C92' = CM '\x10CD2' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EK+foldMapping '\x10C93' = CM '\x10CD3' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER AK+foldMapping '\x10C94' = CM '\x10CD4' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER UNK+foldMapping '\x10C95' = CM '\x10CD5' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EL+foldMapping '\x10C96' = CM '\x10CD6' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ELY+foldMapping '\x10C97' = CM '\x10CD7' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EM+foldMapping '\x10C98' = CM '\x10CD8' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EN+foldMapping '\x10C99' = CM '\x10CD9' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ENY+foldMapping '\x10C9A' = CM '\x10CDA' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER O+foldMapping '\x10C9B' = CM '\x10CDB' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER OO+foldMapping '\x10C9C' = CM '\x10CDC' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE+foldMapping '\x10C9D' = CM '\x10CDD' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE+foldMapping '\x10C9E' = CM '\x10CDE' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER OEE+foldMapping '\x10C9F' = CM '\x10CDF' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EP+foldMapping '\x10CA0' = CM '\x10CE0' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EMP+foldMapping '\x10CA1' = CM '\x10CE1' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ER+foldMapping '\x10CA2' = CM '\x10CE2' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER SHORT ER+foldMapping '\x10CA3' = CM '\x10CE3' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ES+foldMapping '\x10CA4' = CM '\x10CE4' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ESZ+foldMapping '\x10CA5' = CM '\x10CE5' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ET+foldMapping '\x10CA6' = CM '\x10CE6' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ENT+foldMapping '\x10CA7' = CM '\x10CE7' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ETY+foldMapping '\x10CA8' = CM '\x10CE8' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ECH+foldMapping '\x10CA9' = CM '\x10CE9' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER U+foldMapping '\x10CAA' = CM '\x10CEA' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER UU+foldMapping '\x10CAB' = CM '\x10CEB' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE+foldMapping '\x10CAC' = CM '\x10CEC' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE+foldMapping '\x10CAD' = CM '\x10CED' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EV+foldMapping '\x10CAE' = CM '\x10CEE' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EZ+foldMapping '\x10CAF' = CM '\x10CEF' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER EZS+foldMapping '\x10CB0' = CM '\x10CF0' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN+foldMapping '\x10CB1' = CM '\x10CF1' '\0' '\0'+-- OLD HUNGARIAN CAPITAL LETTER US+foldMapping '\x10CB2' = CM '\x10CF2' '\0' '\0'+-- WARANG CITI CAPITAL LETTER NGAA+foldMapping '\x118A0' = CM '\x118C0' '\0' '\0'+-- WARANG CITI CAPITAL LETTER A+foldMapping '\x118A1' = CM '\x118C1' '\0' '\0'+-- WARANG CITI CAPITAL LETTER WI+foldMapping '\x118A2' = CM '\x118C2' '\0' '\0'+-- WARANG CITI CAPITAL LETTER YU+foldMapping '\x118A3' = CM '\x118C3' '\0' '\0'+-- WARANG CITI CAPITAL LETTER YA+foldMapping '\x118A4' = CM '\x118C4' '\0' '\0'+-- WARANG CITI CAPITAL LETTER YO+foldMapping '\x118A5' = CM '\x118C5' '\0' '\0'+-- WARANG CITI CAPITAL LETTER II+foldMapping '\x118A6' = CM '\x118C6' '\0' '\0'+-- WARANG CITI CAPITAL LETTER UU+foldMapping '\x118A7' = CM '\x118C7' '\0' '\0'+-- WARANG CITI CAPITAL LETTER E+foldMapping '\x118A8' = CM '\x118C8' '\0' '\0'+-- WARANG CITI CAPITAL LETTER O+foldMapping '\x118A9' = CM '\x118C9' '\0' '\0'+-- WARANG CITI CAPITAL LETTER ANG+foldMapping '\x118AA' = CM '\x118CA' '\0' '\0'+-- WARANG CITI CAPITAL LETTER GA+foldMapping '\x118AB' = CM '\x118CB' '\0' '\0'+-- WARANG CITI CAPITAL LETTER KO+foldMapping '\x118AC' = CM '\x118CC' '\0' '\0'+-- WARANG CITI CAPITAL LETTER ENY+foldMapping '\x118AD' = CM '\x118CD' '\0' '\0'+-- WARANG CITI CAPITAL LETTER YUJ+foldMapping '\x118AE' = CM '\x118CE' '\0' '\0'+-- WARANG CITI CAPITAL LETTER UC+foldMapping '\x118AF' = CM '\x118CF' '\0' '\0'+-- WARANG CITI CAPITAL LETTER ENN+foldMapping '\x118B0' = CM '\x118D0' '\0' '\0'+-- WARANG CITI CAPITAL LETTER ODD+foldMapping '\x118B1' = CM '\x118D1' '\0' '\0'+-- WARANG CITI CAPITAL LETTER TTE+foldMapping '\x118B2' = CM '\x118D2' '\0' '\0'+-- WARANG CITI CAPITAL LETTER NUNG+foldMapping '\x118B3' = CM '\x118D3' '\0' '\0'+-- WARANG CITI CAPITAL LETTER DA+foldMapping '\x118B4' = CM '\x118D4' '\0' '\0'+-- WARANG CITI CAPITAL LETTER AT+foldMapping '\x118B5' = CM '\x118D5' '\0' '\0'+-- WARANG CITI CAPITAL LETTER AM+foldMapping '\x118B6' = CM '\x118D6' '\0' '\0'+-- WARANG CITI CAPITAL LETTER BU+foldMapping '\x118B7' = CM '\x118D7' '\0' '\0'+-- WARANG CITI CAPITAL LETTER PU+foldMapping '\x118B8' = CM '\x118D8' '\0' '\0'+-- WARANG CITI CAPITAL LETTER HIYO+foldMapping '\x118B9' = CM '\x118D9' '\0' '\0'+-- WARANG CITI CAPITAL LETTER HOLO+foldMapping '\x118BA' = CM '\x118DA' '\0' '\0'+-- WARANG CITI CAPITAL LETTER HORR+foldMapping '\x118BB' = CM '\x118DB' '\0' '\0'+-- WARANG CITI CAPITAL LETTER HAR+foldMapping '\x118BC' = CM '\x118DC' '\0' '\0'+-- WARANG CITI CAPITAL LETTER SSUU+foldMapping '\x118BD' = CM '\x118DD' '\0' '\0'+-- WARANG CITI CAPITAL LETTER SII+foldMapping '\x118BE' = CM '\x118DE' '\0' '\0'+-- WARANG CITI CAPITAL LETTER VIYO+foldMapping '\x118BF' = CM '\x118DF' '\0' '\0'+-- ADLAM CAPITAL LETTER ALIF+foldMapping '\x1E900' = CM '\x1E922' '\0' '\0'+-- ADLAM CAPITAL LETTER DAALI+foldMapping '\x1E901' = CM '\x1E923' '\0' '\0'+-- ADLAM CAPITAL LETTER LAAM+foldMapping '\x1E902' = CM '\x1E924' '\0' '\0'+-- ADLAM CAPITAL LETTER MIIM+foldMapping '\x1E903' = CM '\x1E925' '\0' '\0'+-- ADLAM CAPITAL LETTER BA+foldMapping '\x1E904' = CM '\x1E926' '\0' '\0'+-- ADLAM CAPITAL LETTER SINNYIIYHE+foldMapping '\x1E905' = CM '\x1E927' '\0' '\0'+-- ADLAM CAPITAL LETTER PE+foldMapping '\x1E906' = CM '\x1E928' '\0' '\0'+-- ADLAM CAPITAL LETTER BHE+foldMapping '\x1E907' = CM '\x1E929' '\0' '\0'+-- ADLAM CAPITAL LETTER RA+foldMapping '\x1E908' = CM '\x1E92A' '\0' '\0'+-- ADLAM CAPITAL LETTER E+foldMapping '\x1E909' = CM '\x1E92B' '\0' '\0'+-- ADLAM CAPITAL LETTER FA+foldMapping '\x1E90A' = CM '\x1E92C' '\0' '\0'+-- ADLAM CAPITAL LETTER I+foldMapping '\x1E90B' = CM '\x1E92D' '\0' '\0'+-- ADLAM CAPITAL LETTER O+foldMapping '\x1E90C' = CM '\x1E92E' '\0' '\0'+-- ADLAM CAPITAL LETTER DHA+foldMapping '\x1E90D' = CM '\x1E92F' '\0' '\0'+-- ADLAM CAPITAL LETTER YHE+foldMapping '\x1E90E' = CM '\x1E930' '\0' '\0'+-- ADLAM CAPITAL LETTER WAW+foldMapping '\x1E90F' = CM '\x1E931' '\0' '\0'+-- ADLAM CAPITAL LETTER NUN+foldMapping '\x1E910' = CM '\x1E932' '\0' '\0'+-- ADLAM CAPITAL LETTER KAF+foldMapping '\x1E911' = CM '\x1E933' '\0' '\0'+-- ADLAM CAPITAL LETTER YA+foldMapping '\x1E912' = CM '\x1E934' '\0' '\0'+-- ADLAM CAPITAL LETTER U+foldMapping '\x1E913' = CM '\x1E935' '\0' '\0'+-- ADLAM CAPITAL LETTER JIIM+foldMapping '\x1E914' = CM '\x1E936' '\0' '\0'+-- ADLAM CAPITAL LETTER CHI+foldMapping '\x1E915' = CM '\x1E937' '\0' '\0'+-- ADLAM CAPITAL LETTER HA+foldMapping '\x1E916' = CM '\x1E938' '\0' '\0'+-- ADLAM CAPITAL LETTER QAAF+foldMapping '\x1E917' = CM '\x1E939' '\0' '\0'+-- ADLAM CAPITAL LETTER GA+foldMapping '\x1E918' = CM '\x1E93A' '\0' '\0'+-- ADLAM CAPITAL LETTER NYA+foldMapping '\x1E919' = CM '\x1E93B' '\0' '\0'+-- ADLAM CAPITAL LETTER TU+foldMapping '\x1E91A' = CM '\x1E93C' '\0' '\0'+-- ADLAM CAPITAL LETTER NHA+foldMapping '\x1E91B' = CM '\x1E93D' '\0' '\0'+-- ADLAM CAPITAL LETTER VA+foldMapping '\x1E91C' = CM '\x1E93E' '\0' '\0'+-- ADLAM CAPITAL LETTER KHA+foldMapping '\x1E91D' = CM '\x1E93F' '\0' '\0'+-- ADLAM CAPITAL LETTER GBE+foldMapping '\x1E91E' = CM '\x1E940' '\0' '\0'+-- ADLAM CAPITAL LETTER ZAL+foldMapping '\x1E91F' = CM '\x1E941' '\0' '\0'+-- ADLAM CAPITAL LETTER KPO+foldMapping '\x1E920' = CM '\x1E942' '\0' '\0'+-- ADLAM CAPITAL LETTER SHA+foldMapping '\x1E921' = CM '\x1E943' '\0' '\0'+foldMapping c = CM (toLower c) '\0' '\0'
+ Basement/String/Encoding/ASCII7.hs view
@@ -0,0 +1,85 @@+-- |+-- Module      : Basement.String.Encoding.ASCII7+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE MagicHash #-}++module Basement.String.Encoding.ASCII7+    ( ASCII7(..)+    , ASCII7_Invalid(..)+    ) where++import Basement.Compat.Base+import Basement.Types.OffsetSize+import Basement.Numerical.Additive+import Basement.Monad++import GHC.Prim+import GHC.Word+import GHC.Types+import Basement.UArray+import Basement.UArray.Mutable (MUArray)+import Basement.MutableBuilder++import Basement.String.Encoding.Encoding+import Basement.HeadHackageUtils++-- | validate a given byte is within ASCII characters encoring size+--+-- This function check the 8th bit is set to 0+--+isAscii :: Word8 -> Bool+isAscii (W8# w) = W8# (wordToWord8Compat# (and# (word8ToWordCompat# w) 0x80## )) == 0+{-# INLINE isAscii #-}++data ASCII7_Invalid+    = ByteOutOfBound Word8+    | CharNotAscii   Char+  deriving (Typeable, Show, Eq)+instance Exception ASCII7_Invalid++data ASCII7 = ASCII7++instance Encoding ASCII7 where+    type Unit ASCII7 = Word8+    type Error ASCII7 = ASCII7_Invalid+    encodingNext  _ = next+    encodingWrite _ = write++-- | consume an Ascii7 char and return the Unicode point and the position+-- of the next possible Ascii7 char+--+next :: (Offset Word8 -> Word8)+          -- ^ method to access a given byte+     -> Offset Word8+          -- ^ index of the byte+     -> Either ASCII7_Invalid (Char, Offset Word8)+          -- ^ either successfully validated the ASCII char and returned the+          -- next index or fail with an error+next getter off+    | isAscii w8 = Right (toChar (word8ToWordCompat# w), off + 1)+    | otherwise  = Left $ ByteOutOfBound w8+  where+    !w8@(W8# w) = getter off+    toChar :: Word# -> Char+    toChar a = C# (chr# (word2Int# a))++-- Write ascii char+--+-- > build 64 $ sequence_ write "this is a simple list of char..."+--+write :: (PrimMonad st, Monad st)+      => Char+           -- ^ expecting it to be a valid Ascii character.+           -- otherwise this function will throw an exception+      -> Builder (UArray Word8) (MUArray Word8) Word8 st err ()+write c+    | c < toEnum 0x80 = builderAppend $ w8 c+    | otherwise       = throw $ CharNotAscii c+  where+    w8 :: Char -> Word8+    w8 (C# ch) = W8# (wordToWord8Compat# (int2Word# (ord# ch)))
+ Basement/String/Encoding/Encoding.hs view
@@ -0,0 +1,102 @@+-- |+-- Module      : Basement.String.Encoding.Encoding+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE FlexibleContexts #-}++module Basement.String.Encoding.Encoding+    ( Encoding(..)+    , convertFromTo+    ) where++import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.PrimType+import           Basement.MutableBuilder+import           Basement.Numerical.Additive+import           Basement.UArray (UArray)+import           Basement.UArray.Mutable (MUArray)+import qualified Basement.UArray as Vec++class Encoding encoding where+    -- | the unit element use for the encoding.+    -- i.e. Word8 for ASCII7 or UTF8, Word16 for UTF16...+    --+    type Unit encoding++    -- | define the type of error handling you want to use for the+    -- next function.+    --+    -- > type Error UTF8 = Either UTF8_Invalid+    --+    type Error encoding++    -- | consume an `Unit encoding` and return the Unicode point and the position+    -- of the next possible `Unit encoding`+    --+    encodingNext :: encoding+                      -- ^ only used for type deduction+                -> (Offset (Unit encoding) -> Unit encoding)+                      -- ^ method to access a given `Unit encoding`+                      -- (see `unsafeIndexer`)+                -> Offset (Unit encoding)+                      -- ^ offset of the `Unit encoding` where starts the+                      -- encoding of a given unicode+                -> Either (Error encoding) (Char, Offset (Unit encoding)) -- ^ either successfully validated the `Unit encoding`+                      -- and returned the next offset or fail with an+                      -- `Error encoding`++    -- Write a unicode point encoded into one or multiple `Unit encoding`+    --+    -- > build 64 $ sequence_ (write UTF8) "this is a simple list of char..."+    --+    encodingWrite :: (PrimMonad st, Monad st)+                  => encoding+                      -- ^ only used for type deduction+                  -> Char+                      -- ^ the unicode character to encode+                  -> Builder (UArray (Unit encoding))+                             (MUArray (Unit encoding))+                             (Unit encoding) st err ()++-- | helper to convert a given Array in a given encoding into an array+-- with another encoding.+--+-- This is a helper to convert from one String encoding to another.+-- This function is (quite) slow and needs some work.+--+-- ```+-- let s16 = ... -- string in UTF16+-- -- create s8, a UTF8 String+-- let s8  = runST $ convertWith UTF16 UTF8 (toBytes s16)+--+-- print s8+-- ```+--+convertFromTo :: ( PrimMonad st, Monad st+                 , Encoding input, PrimType (Unit input)+                 , Encoding output, PrimType (Unit output)+                 )+              => input+                -- ^ Input's encoding type+              -> output+                -- ^ Output's encoding type+              -> UArray (Unit input)+                -- ^ the input raw array+              -> st (Either (Offset (Unit input), Error input) (UArray (Unit output)))+convertFromTo inputEncodingTy outputEncodingTy bytes+    | Vec.null bytes = return . return $ mempty+    | otherwise      = Vec.unsafeIndexer bytes $ \t -> Vec.builderBuild 64 (loop azero t)+  where+    lastUnit = Vec.length bytes++    loop off getter+      | off .==# lastUnit = return ()+      | otherwise = case encodingNext inputEncodingTy getter off of+          Left err -> mFail (off, err)+          Right (c, noff) -> encodingWrite outputEncodingTy c >> loop noff getter
+ Basement/String/Encoding/ISO_8859_1.hs view
@@ -0,0 +1,65 @@+-- |+-- Module      : Basement.String.Encoding.ISO_8859_1+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE MagicHash #-}++module Basement.String.Encoding.ISO_8859_1+    ( ISO_8859_1(..)+    , ISO_8859_1_Invalid(..)+    ) where++import Basement.Compat.Base+import Basement.Types.OffsetSize+import Basement.Numerical.Additive+import Basement.Monad+import Basement.HeadHackageUtils++import GHC.Prim+import GHC.Word+import GHC.Types+import Basement.UArray+import Basement.UArray.Mutable (MUArray)+import Basement.MutableBuilder++import Basement.String.Encoding.Encoding++-- offset of size one+aone :: Offset Word8+aone = Offset 1++data ISO_8859_1_Invalid+    = NotISO_8859_1 Char+  deriving (Typeable, Show, Eq)+instance Exception ISO_8859_1_Invalid++data ISO_8859_1 = ISO_8859_1++instance Encoding ISO_8859_1 where+    type Unit ISO_8859_1 = Word8+    type Error ISO_8859_1 = ISO_8859_1_Invalid+    encodingNext  _ = next+    encodingWrite _ = write++next :: (Offset Word8 -> Word8)+     -> Offset Word8+     -> Either ISO_8859_1_Invalid (Char, Offset Word8)+next getter off = Right (toChar (word8ToWordCompat# w), off + aone)+  where+    !(W8# w) = getter off+    toChar :: Word# -> Char+    toChar a = C# (chr# (word2Int# a))++write :: (PrimMonad st, Monad st)+      => Char+      -> Builder (UArray Word8) (MUArray Word8) Word8 st err ()+write c@(C# ch)+    | c <= toEnum 0xFF = builderAppend (W8# (wordToWord8Compat# x))+    | otherwise        = throw $ NotISO_8859_1 c+  where+    x :: Word#+    !x = int2Word# (ord# ch)
+ Basement/String/Encoding/UTF16.hs view
@@ -0,0 +1,98 @@+-- |+-- Module      : Basement.String.Encoding.UTF16+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+module Basement.String.Encoding.UTF16+    ( UTF16(..)+    , UTF16_Invalid(..)+    ) where++import GHC.Prim+import GHC.Word+import GHC.Types+import Data.Bits+import qualified Prelude+import Basement.Compat.Base+import Basement.Types.OffsetSize+import Basement.Monad+import Basement.Numerical.Additive+import Basement.UArray+import Basement.UArray.Mutable (MUArray)+import Basement.MutableBuilder+import Basement.HeadHackageUtils++import Basement.String.Encoding.Encoding++data UTF16_Invalid+    = InvalidContinuation+    | InvalidUnicode Char+  deriving (Show, Eq, Typeable)+instance Exception UTF16_Invalid++data UTF16 = UTF16++instance Encoding UTF16 where+    type Unit UTF16 = Word16+    type Error UTF16 = UTF16_Invalid+    encodingNext  _ = next+    encodingWrite _ = write+++--+-- U+0000 to U+D7FF and U+E000 to U+FFFF : 1 bytes+-- U+10000 to U+10FFFF :+--    * 0x010000 is subtracted from the code point, leaving a 20-bit number in the range 0..0x0FFFFF.+--    * The top ten bits (a number in the range 0..0x03FF) are added to 0xD800 to give the first 16-bit code unit+--      or high surrogate, which will be in the range 0xD800..0xDBFF.+--    * The low ten bits (also in the range 0..0x03FF) are added to 0xDC00 to give the second 16-bit code unit+--      or low surrogate, which will be in the range 0xDC00..0xDFFF.++next :: (Offset Word16 -> Word16)+     -> Offset Word16+     -> Either UTF16_Invalid (Char, Offset Word16)+next getter off+    | h <  0xd800 = Right (toChar (word16ToWordCompat# hh), off + Offset 1)+    | h >= 0xe000 = Right (toChar (word16ToWordCompat# hh), off + Offset 1)+    | otherwise   = nextContinuation+  where+    h :: Word16+    !h@(W16# hh) = getter off+    toChar :: Word# -> Char+    toChar w = C# (chr# (word2Int# w))+    to32 :: Word16 -> Word32+    to32 (W16# w) = W32# (wordToWord32Compat# (word16ToWordCompat# w))++    nextContinuation+        | cont >= 0xdc00 && cont < 0xe00 =+            let !(W32# w) = ((to32 h .&. 0x3ff) `shiftL` 10)+                         .|. (to32 cont .&. 0x3ff)+             in Right (toChar (word32ToWordCompat# w), off + Offset 2)+        | otherwise = Left InvalidContinuation+      where+        cont :: Word16+        !cont = getter $ off + Offset 1++write :: (PrimMonad st, Monad st)+      => Char+      -> Builder (UArray Word16) (MUArray Word16) Word16 st err ()+write c+    | c < toEnum 0xd800   = builderAppend $ w16 c+    | c > toEnum 0x10000  = let (w1, w2) = wHigh c in builderAppend w1 >> builderAppend w2+    | c > toEnum 0x10ffff = throw $ InvalidUnicode c+    | c >= toEnum 0xe000  = builderAppend $ w16 c+    | otherwise = throw $ InvalidUnicode c+  where+    w16 :: Char -> Word16+    w16 (C# ch) = W16# (wordToWord16Compat# (int2Word# (ord# ch)))++    to16 :: Word32 -> Word16+    to16 = Prelude.fromIntegral++    wHigh :: Char -> (Word16, Word16)+    wHigh (C# ch) =+        let v = W32# (wordToWord32Compat# (minusWord# (int2Word# (ord# ch)) 0x10000##))+         in (0xdc00 .|. to16 (v `shiftR` 10), 0xd800 .|. to16 (v .&. 0x3ff))
+ Basement/String/Encoding/UTF32.hs view
@@ -0,0 +1,56 @@+-- |+-- Module      : Basement.String.Encoding.UTF32+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+module Basement.String.Encoding.UTF32+    ( UTF32(..)+    , UTF32_Invalid+    ) where++import GHC.Prim+import GHC.Word+import GHC.Types+import Basement.Compat.Base+import Basement.Types.OffsetSize+import Basement.Monad+import Basement.Numerical.Additive+import Basement.UArray+import Basement.UArray.Mutable (MUArray)+import Basement.MutableBuilder+import Basement.HeadHackageUtils++import Basement.String.Encoding.Encoding++data UTF32 = UTF32++data UTF32_Invalid = UTF32_Invalid+  deriving (Typeable, Show, Eq, Ord, Enum, Bounded)+instance Exception UTF32_Invalid++instance Encoding UTF32 where+    type Unit UTF32 = Word32+    type Error UTF32 = UTF32_Invalid+    encodingNext  _ = next+    encodingWrite _ = write++next :: (Offset Word32 -> Word32)+     -> Offset Word32+     -> Either UTF32_Invalid (Char, Offset Word32)+next getter off = Right (char, off + Offset 1)+  where+    !(W32# hh) = getter off+    char :: Char+    char = C# (chr# (word2Int# (word32ToWordCompat# hh)))++write :: (PrimMonad st, Monad st)+      => Char+      -> Builder (UArray Word32) (MUArray Word32) Word32 st err ()+write c = builderAppend w32+  where+    !(C# ch) = c+    w32 :: Word32+    w32 = W32# (wordToWord32Compat# (int2Word# (ord# ch)))
+ Basement/Terminal.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE CPP #-}+module Basement.Terminal+    ( initialize+    , getDimensions+    ) where++import Basement.Compat.Base+import Basement.Terminal.Size (getDimensions)+#ifdef mingw32_HOST_OS+import System.IO (hSetEncoding, utf8, hPutStrLn, stderr, stdin, stdout)+import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP)+#endif++initialize :: IO ()+initialize = do+#ifdef mingw32_HOST_OS+    query getConsoleOutputCP (\e -> setConsoleOutputCP e >> hSetEncoding stdout utf8 >> hSetEncoding stderr utf8) utf8Code+    query getConsoleCP (\e -> setConsoleCP e >> hSetEncoding stdin utf8) utf8Code+  where+    utf8Code = 65001+    query get set expected = do+        v <- get+        if v == expected then pure () else set expected+#else+    pure ()+#endif
+ Basement/Terminal/ANSI.hs view
@@ -0,0 +1,170 @@+-- |+-- Module      : Basement.Terminal.ANSI+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+--+-- ANSI Terminal escape for cursor and attributes manipulations+--+-- On Unix system, it should be supported by most terminal emulators.+--+-- On Windows system, all escape sequences are empty for maximum+-- compatibility purpose, and easy implementation. newer version+-- of Windows 10 supports ANSI escape now, but we'll need+-- some kind of detection.+--+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+module Basement.Terminal.ANSI+    (+    -- * Types+      Escape+    , Displacement+    , ColorComponent+    , GrayComponent+    , RGBComponent+    -- * Simple ANSI escape factory functions+    , cursorUp+    , cursorDown+    , cursorForward+    , cursorBack+    , cursorNextLine+    , cursorPrevLine+    , cursorHorizontalAbsolute+    , cursorPosition+    , eraseScreenFromCursor+    , eraseScreenToCursor+    , eraseScreenAll+    , eraseLineFromCursor+    , eraseLineToCursor+    , eraseLineAll+    , scrollUp+    , scrollDown+    , sgrReset+    , sgrForeground+    , sgrBackground+    , sgrForegroundGray24+    , sgrBackgroundGray24+    , sgrForegroundColor216+    , sgrBackgroundColor216+    ) where++import Basement.String+import Basement.Bounded+import Basement.Imports+import Basement.Numerical.Multiplicative+import Basement.Numerical.Additive++#ifndef mingw32_HOST_OS+#define SUPPORT_ANSI_ESCAPE+#endif++type Escape = String++type Displacement = Word64++-- | Simple color component on 8 color terminal (maximum compatibility)+type ColorComponent = Zn64 8++-- | Gray color compent on 256colors terminals+type GrayComponent = Zn64 24++-- | Color compent on 256colors terminals+type RGBComponent = Zn64 6++cursorUp, cursorDown, cursorForward, cursorBack+    , cursorNextLine, cursorPrevLine+    , cursorHorizontalAbsolute :: Displacement -> Escape+cursorUp n = csi1 n "A"+cursorDown n = csi1 n "B"+cursorForward n = csi1 n "C"+cursorBack n = csi1 n "D"+cursorNextLine n = csi1 n "E"+cursorPrevLine n = csi1 n "F"+cursorHorizontalAbsolute n = csi1 n "G"++cursorPosition :: Displacement -> Displacement -> Escape+cursorPosition row col = csi2 row col "H"++eraseScreenFromCursor+    , eraseScreenToCursor+    , eraseScreenAll+    , eraseLineFromCursor+    , eraseLineToCursor+    , eraseLineAll :: Escape+eraseScreenFromCursor = csi1 0 "J"+eraseScreenToCursor = csi1 1 "J"+eraseScreenAll = csi1 2 "J"+eraseLineFromCursor = csi1 0 "K"+eraseLineToCursor = csi1 1 "K"+eraseLineAll = csi1 2 "K"++scrollUp, scrollDown :: Displacement -> Escape+scrollUp n = csi1 n "S"+scrollDown n = csi1 n "T"++-- | All attribute off+sgrReset :: Escape+sgrReset = csi1 0 "m"++-- | 8 Colors + Bold attribute for foreground+sgrForeground :: ColorComponent -> Bool -> Escape+sgrForeground n bold+    | bold      = csi2 (30+unZn64 n) 1 "m"+    | otherwise = csi1 (30+unZn64 n) "m"++-- | 8 Colors + Bold attribute for background+sgrBackground :: ColorComponent -> Bool -> Escape+sgrBackground n bold+    | bold      = csi2 (40+unZn64 n) 1 "m" +    | otherwise = csi1 (40+unZn64 n) "m"++-- 256 colors mode++sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape+sgrForegroundGray24 v = csi3 38 5 (0xE8 + unZn64 v) "m"+sgrBackgroundGray24 v = csi3 48 5 (0xE8 + unZn64 v) "m"++sgrForegroundColor216 :: RGBComponent -- ^ Red component+                      -> RGBComponent -- ^ Green component+                      -> RGBComponent -- ^ Blue component+                      -> Escape+sgrForegroundColor216 r g b = csi3 38 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m"++sgrBackgroundColor216 :: RGBComponent -- ^ Red component+                      -> RGBComponent -- ^ Green component+                      -> RGBComponent -- ^ Blue component+                      -> Escape+sgrBackgroundColor216 r g b = csi3 48 5 (0x10 + 36 * unZn64 r + 6 * unZn64 g + unZn64 b) "m"++#ifdef SUPPORT_ANSI_ESCAPE++csi0 :: String -> String+csi0 suffix = mconcat ["\ESC[", suffix]++csi1 :: Displacement -> String -> String+csi1 p1 suffix = mconcat ["\ESC[", pshow p1, suffix]++csi2 :: Displacement -> Displacement -> String -> String+csi2 p1 p2 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, suffix]++csi3 :: Displacement -> Displacement -> Displacement -> String -> String+csi3 p1 p2 p3 suffix = mconcat ["\ESC[", pshow p1, ";", pshow p2, ";", pshow p3, suffix]++pshow = show++#else++csi0 :: String -> String+csi0 _ = ""++csi1 :: Displacement -> String -> String+csi1 _ _ = ""++csi2 :: Displacement -> Displacement -> String -> String+csi2 _ _ _ = ""++csi3 :: Displacement -> Displacement -> Displacement -> String -> String+csi3 _ _ _ _ = ""++#endif
+ Basement/Terminal/Size.hsc view
@@ -0,0 +1,190 @@+{-# LANGUAGE CApiFFI #-}+module Basement.Terminal.Size +    ( getDimensions+    ) where+        +import           Foreign+import           Foreign.C+import           Basement.Compat.Base+import           Basement.Types.OffsetSize+import           Basement.Numerical.Subtractive+import           Basement.Numerical.Additive+import           Prelude (fromIntegral)++#include "foundation_system.h"+#ifdef FOUNDATION_SYSTEM_WINDOWS++import           System.Win32.Types (HANDLE, BOOL)+import           Graphics.Win32.Misc (getStdHandle, sTD_OUTPUT_HANDLE, StdHandleId)++#include <windows.h>+#elif defined FOUNDATION_SYSTEM_UNIX+#include <sys/ioctl.h>+#ifdef __sun+#include <sys/termios.h>+#endif+#endif ++#include <stdio.h>++#if __GLASGOW_HASKELL__ < 800+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)+#endif++#ifdef FOUNDATION_SYSTEM_UNIX+data Winsize = Winsize+    { ws_row    :: !Word16+    , ws_col    :: !Word16+    , ws_xpixel :: !Word16+    , ws_ypixel :: !Word16+    }++instance Storable Winsize where+    sizeOf _ = #{size struct winsize}+    alignment _ = #{alignment struct winsize}+    peek ptr = do+        r <- #{peek struct winsize, ws_row} ptr+        c <- #{peek struct winsize, ws_col} ptr+        x <- #{peek struct winsize, ws_xpixel} ptr+        y <- #{peek struct winsize, ws_ypixel} ptr+        return (Winsize r c x y)+    poke ptr (Winsize r c x y) = do+        #{poke struct winsize, ws_row} ptr r+        #{poke struct winsize, ws_col} ptr c+        #{poke struct winsize, ws_xpixel} ptr x+        #{poke struct winsize, ws_ypixel} ptr y+        +#elif defined FOUNDATION_SYSTEM_WINDOWS+type Handle = Ptr CChar  -- void *++data SmallRect = SmallRect +    { left   :: !Int16+    , top    :: !Int16+    , right  :: !Int16+    , bottom :: !Int16+    } deriving (Show)++instance Storable SmallRect where+    sizeOf _ = #{size SMALL_RECT}+    alignment _ = #{alignment SMALL_RECT}+    peek ptr = do+        l <- #{peek SMALL_RECT, Left} ptr+        r <- #{peek SMALL_RECT, Right} ptr+        t <- #{peek SMALL_RECT, Top} ptr+        b <- #{peek SMALL_RECT, Bottom} ptr+        return (SmallRect l t r b)+    poke ptr (SmallRect l t r b) = do+        #{poke SMALL_RECT, Left} ptr l+        #{poke SMALL_RECT, Top} ptr t+        #{poke SMALL_RECT, Right} ptr r+        #{poke SMALL_RECT, Bottom} ptr b+        +data Coord = Coord +    { x :: !Int16+    , y :: !Int16+    } deriving (Show)++instance Storable Coord where+    sizeOf _ = #{size COORD}+    alignment _ = #{alignment COORD}+    peek ptr = do+        x <- #{peek COORD, X} ptr+        y <- #{peek COORD, Y} ptr+        return (Coord x y)+    poke ptr (Coord x y) = do+        #{poke COORD, X} ptr x+        #{poke COORD, Y} ptr y++data ConsoleScreenBufferInfo = ConsoleScreenBufferInfo +    { dwSize              :: !Coord+    , dwCursorPosition    :: !Coord+    , wAttributes         :: !Word16+    , srWindow            :: !SmallRect+    , dwMaximumWindowSize :: !Coord+    } deriving (Show)++instance Storable ConsoleScreenBufferInfo where+    sizeOf _ = #{size CONSOLE_SCREEN_BUFFER_INFO}+    alignment _ = #{alignment CONSOLE_SCREEN_BUFFER_INFO}+    peek ptr = do+        s <- #{peek CONSOLE_SCREEN_BUFFER_INFO, dwSize} ptr+        c <- #{peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition} ptr+        a <- #{peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes} ptr+        w <- #{peek CONSOLE_SCREEN_BUFFER_INFO, srWindow} ptr+        m <- #{peek CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize} ptr+        return (ConsoleScreenBufferInfo s c a w m)+    poke ptr (ConsoleScreenBufferInfo s c a w m) = do+        #{poke CONSOLE_SCREEN_BUFFER_INFO, dwSize} ptr s+        #{poke CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition} ptr c+        #{poke CONSOLE_SCREEN_BUFFER_INFO, wAttributes} ptr a+        #{poke CONSOLE_SCREEN_BUFFER_INFO, srWindow} ptr w+        #{poke CONSOLE_SCREEN_BUFFER_INFO, dwMaximumWindowSize} ptr m+    +invalidHandleValue :: IntPtr+invalidHandleValue = #{const INVALID_HANDLE_VALUE}++stdOutputHandle :: CULong+stdOutputHandle = #{const STD_OUTPUT_HANDLE}+#endif+-- defined FOUNDATION_SYSTEM_WINDOWS++#ifdef FOUNDATION_SYSTEM_UNIX++foreign import capi "sys/ioctl.h ioctl" c_ioctl :: CInt -> CULong -> Ptr a -> IO CInt++-- | Get the terminal windows size+tiocgwinsz :: CULong+tiocgwinsz = Prelude.fromIntegral (#{const TIOCGWINSZ} :: Word)++#elif defined FOUNDATION_SYSTEM_WINDOWS+foreign import ccall "GetConsoleScreenBufferInfo" c_get_console_screen_buffer_info +  :: HANDLE -> Ptr ConsoleScreenBufferInfo -> IO BOOL+#endif++#ifdef FOUNDATION_SYSTEM_UNIX+ioctlWinsize :: CInt -> IO (Maybe (CountOf Char, CountOf Char))+ioctlWinsize fd = alloca $ \winsizePtr -> do+    status <- c_ioctl fd tiocgwinsz winsizePtr+    if status == (-1 :: CInt)+        then pure Nothing+        else Just . toDimensions <$> peek winsizePtr+  where+    toDimensions winsize =+        ( CountOf . Prelude.fromIntegral . ws_col $ winsize+        , CountOf . Prelude.fromIntegral . ws_row $ winsize)+       +#elif defined FOUNDATION_SYSTEM_WINDOWS+getConsoleScreenBufferInfo :: HANDLE -> IO (Maybe ConsoleScreenBufferInfo)+getConsoleScreenBufferInfo handle = alloca $ \infoPtr -> do+    status <- c_get_console_screen_buffer_info handle infoPtr+    if status+        then Just <$> peek infoPtr+        else pure Nothing+       +winWinsize :: StdHandleId -> IO (Maybe (CountOf Char, CountOf Char))+winWinsize handleRef = (infoToDimensions <$>) <$>+    (getStdHandle handleRef >>= getConsoleScreenBufferInfo)+  where+    infoToDimensions info =+        let window = srWindow info+            width = Prelude.fromIntegral (right window - left window + 1)+            height = Prelude.fromIntegral (bottom window - top window + 1)+         in (CountOf width, CountOf height)+#endif+-- defined FOUNDATION_SYSTEM_WINDOWS++-- | Return the size of the current terminal+--+-- If the system is not supported or that querying the system result in an error+-- then a default size of (80, 24) will be given back.+getDimensions :: IO (CountOf Char, CountOf Char)+getDimensions =+#if defined FOUNDATION_SYSTEM_WINDOWS+    maybe defaultSize id <$> winWinsize sTD_OUTPUT_HANDLE+#elif defined FOUNDATION_SYSTEM_UNIX+    maybe defaultSize id <$> ioctlWinsize 0+#else+    pure defaultSize+#endif+  where+    defaultSize = (80, 24)
+ Basement/These.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Basement.These+-- License     : BSD-style+-- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>+-- Stability   : stable+-- Portability : portable+--+-- @These a b@, sum type to represent either @a@ or @b@ or both.+--+module Basement.These+    ( These(..)+    ) where++import Basement.Compat.Base+import Basement.NormalForm+import Basement.Compat.Bifunctor++-- | Either a or b or both.+data These a b+    = This a+    | That b+    | These a b+  deriving (Eq, Ord, Show, Typeable)++instance (NormalForm a, NormalForm b) => NormalForm (These a b) where+    toNormalForm (This a) = toNormalForm a+    toNormalForm (That b) = toNormalForm b+    toNormalForm (These a b) = toNormalForm a `seq` toNormalForm b++instance Bifunctor These where+    bimap fa _  (This a)    = This  (fa a)+    bimap _  fb (That b)    = That  (fb b)+    bimap fa fb (These a b) = These (fa a) (fb b)++instance Functor (These a) where+    fmap = second
+ Basement/Types/AsciiString.hs view
@@ -0,0 +1,62 @@+-- |+-- Module      : Foundation.Primitives.Types.AsciiString+-- License     : BSD-style+-- Maintainer  : Haskell Foundation+-- Stability   : experimental+-- Portability : portable+--+-- A AsciiString type backed by a `ASCII` encoded byte array and all the necessary+-- functions to manipulate the string.+--+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleContexts           #-}+module Basement.Types.AsciiString+    ( AsciiString(..)+    , MutableAsciiString(..)+    -- * Binary conversion+    , fromBytesUnsafe+    , fromBytes+    ) where++import           Basement.Compat.Base+import           Basement.Compat.Semigroup+import           Basement.Types.Char7+import           Basement.UArray.Base+import qualified Basement.Types.Char7 as Char7+import qualified Basement.UArray as A (all, unsafeRecast)++-- | Opaque packed array of characters in the ASCII encoding+newtype AsciiString = AsciiString { toBytes :: UArray Char7 }+    deriving (Typeable, Semigroup, Monoid, Eq, Ord)++newtype MutableAsciiString st = MutableAsciiString (MUArray Char7 st)+    deriving (Typeable)++instance Show AsciiString where+    show = fmap Char7.toChar . toList+instance IsString AsciiString where+    fromString = fromList . fmap Char7.fromCharMask+instance IsList AsciiString where+    type Item AsciiString = Char7+    fromList = AsciiString . fromList+    toList (AsciiString chars) = toList chars++-- | Convert a Byte Array representing ASCII data directly to an AsciiString without checking for ASCII validity+--+-- If the input contains invalid Char7 value (anything above 0x7f),+-- it will trigger runtime async errors when processing data.+--+-- In doubt, use 'fromBytes'+fromBytesUnsafe :: UArray Word8 -> AsciiString+fromBytesUnsafe = AsciiString . A.unsafeRecast++-- | Convert a Byte Array representing ASCII checking validity.+--+-- If the byte array is not valid, then Nothing is returned+fromBytes :: UArray Word8 -> Maybe AsciiString+fromBytes arr+    | A.all (\x -> x < 0x80) arr = Just $ AsciiString $ A.unsafeRecast arr+    | otherwise                  = Nothing
+ Basement/Types/Char7.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE BangPatterns               #-}+module Basement.Types.Char7+    ( Char7(..)+    , toChar+    , fromCharMask+    , fromChar+    , fromByteMask+    , fromByte+    -- * individual ASCII Characters+    , c7_LF+    , c7_CR+    , c7_minus+    , c7_a+    , c7_A+    , c7_z+    , c7_Z+    , c7_0+    , c7_1+    , c7_2+    , c7_3+    , c7_4+    , c7_5+    , c7_6+    , c7_7+    , c7_8+    , c7_9+    -- * Upper / Lower With ASCII+    , c7Upper+    , c7Lower+    ) where++import GHC.Prim+import GHC.Word+import GHC.Types+import Data.Bits+import Data.Maybe+import Basement.Compat.Base+import Basement.Compat.Primitive (bool#)+import Basement.HeadHackageUtils++-- | ASCII value between 0x0 and 0x7f+newtype Char7 = Char7 { toByte :: Word8 }+    deriving (Show,Eq,Ord,Typeable)++-- | Convert a 'Char7' to a unicode code point 'Char'+toChar :: Char7 -> Char+toChar !(Char7 (W8# w)) = C# (chr# (word2Int# (word8ToWordCompat# w)))++-- | Try to convert a 'Char' to a 'Char7'+--+-- If the code point is non ascii, then Nothing is returned.+fromChar :: Char -> Maybe Char7+fromChar !(C# c#)+    | bool# (ltChar# c# (chr# 0x80#)) = Just $ Char7 $ W8# (wordToWord8Compat# (int2Word# (ord# c#)))+    | otherwise                       = Nothing++-- | Try to convert 'Word8' to a 'Char7'+--+-- If the byte got higher bit set, then Nothing is returned.+fromByte :: Word8 -> Maybe Char7+fromByte !w+    | (w .&. 0x80) == 0 = Just $ Char7 w+    | otherwise         = Nothing++-- | Convert a 'Char' to a 'Char7' ignoring all higher bits+fromCharMask :: Char -> Char7+fromCharMask !(C# c#) = Char7 $ W8# (wordToWord8Compat# (and# (int2Word# (ord# c#)) 0x7f##))++-- | Convert a 'Byte' to a 'Char7' ignoring the higher bit+fromByteMask :: Word8 -> Char7+fromByteMask !(W8# w#) = Char7 $ W8# (wordToWord8Compat# (and# (word8ToWordCompat# w#) 0x7f##))++c7_LF :: Char7+c7_LF = Char7 0xa++c7_CR :: Char7+c7_CR = Char7 0xd++c7_minus :: Char7+c7_minus = Char7 0x2d++c7_a :: Char7+c7_a = Char7 0x61++c7_A :: Char7+c7_A = Char7 0x41++c7_z :: Char7+c7_z = Char7 0x7a++c7_Z :: Char7+c7_Z = Char7 0x5a++c7_0, c7_1, c7_2, c7_3, c7_4, c7_5, c7_6, c7_7, c7_8, c7_9 :: Char7+c7_0 = Char7 0x30+c7_1 = Char7 0x31+c7_2 = Char7 0x32+c7_3 = Char7 0x33+c7_4 = Char7 0x34+c7_5 = Char7 0x35+c7_6 = Char7 0x36+c7_7 = Char7 0x37+c7_8 = Char7 0x38+c7_9 = Char7 0x39++c7Lower :: Char7 -> Char7+c7Lower c@(Char7 w)+    | c <  c7_A = c+    | c <= c7_Z = Char7 (w .|. 0x20)+    | otherwise = c++c7Upper :: Char7 -> Char7+c7Upper c@(Char7 w)+    | c <  c7_a = c+    | c <= c7_z = Char7 (w .&. 0xdf)+    | otherwise = c
+ Basement/Types/CharUTF8.hs view
@@ -0,0 +1,8 @@+module Basement.Types.CharUTF8+    ( CharUTF8(..)+    , encodeCharUTF8+    , decodeCharUTF8+    ) where++import Basement.UTF8.Types+import Basement.UTF8.Helper
+ Basement/Types/OffsetSize.hs view
@@ -0,0 +1,265 @@+-- |+-- Module      : Basement.Types.OffsetSize+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# OPTIONS_GHC -fno-prof-auto          #-}+module Basement.Types.OffsetSize+    ( FileSize(..)+    , Offset(..)+    , Offset8+    , sentinel+    , offsetOfE+    , offsetPlusE+    , offsetMinusE+    , offsetRecast+    , offsetCast+    , offsetSub+    , offsetShiftL+    , offsetShiftR+    , sizeCast+    , sizeLastOffset+    , sizeAsOffset+    , sizeSub+    , countOfRoundUp+    , offsetAsSize+    , (+.)+    , (.==#)+    , CountOf(..)+    , sizeOfE+    , csizeOfOffset+    , csizeOfSize+    , sizeOfCSSize+    , sizeOfCSize+    , Countable+    , Offsetable+    , natValCountOf+    , natValOffset+    ) where++#include "MachDeps.h"++import GHC.Types+import GHC.Word+import GHC.Int+import GHC.Prim+import System.Posix.Types (CSsize (..))+import Data.Bits+import Basement.Compat.Base+import Basement.Compat.C.Types+import Basement.Compat.Semigroup+import Data.Proxy+import Basement.Numerical.Number+import Basement.Numerical.Additive+import Basement.Numerical.Subtractive+import Basement.Numerical.Multiplicative+import Basement.Numerical.Conversion (intToWord)+import Basement.Nat+import Basement.IntegralConv+import Data.List (foldl')+import qualified Prelude++#if WORD_SIZE_IN_BITS < 64+import GHC.IntWord64+#endif++-- | File size in bytes+newtype FileSize = FileSize Word64+    deriving (Show,Eq,Ord)++-- | Offset in bytes used for memory addressing (e.g. in a vector, string, ..)+type Offset8 = Offset Word8++-- | Offset in a data structure consisting of elements of type 'ty'.+--+-- Int is a terrible backing type which is hard to get away from,+-- considering that GHC/Haskell are mostly using this for offset.+-- Trying to bring some sanity by a lightweight wrapping.+newtype Offset ty = Offset Int+    deriving (Show,Eq,Ord,Enum,Additive,Typeable,Integral,Prelude.Num)++sentinel = Offset (-1)++instance IsIntegral (Offset ty) where+    toInteger (Offset i) = toInteger i+instance IsNatural (Offset ty) where+    toNatural (Offset i) = toNatural (intToWord i)+instance Subtractive (Offset ty) where+    type Difference (Offset ty) = CountOf ty+    (Offset a) - (Offset b) = CountOf (a-b)++(+.) :: Offset ty -> Int -> Offset ty+(+.) (Offset a) b = Offset (a + b)+{-# INLINE (+.) #-}++-- . is offset (as a pointer from a beginning), and # is the size (amount of data)+(.==#) :: Offset ty -> CountOf ty -> Bool+(.==#) (Offset ofs) (CountOf sz) = ofs == sz+{-# INLINE (.==#) #-}++offsetOfE :: CountOf Word8 -> Offset ty -> Offset8+offsetOfE (CountOf sz) (Offset ty) = Offset (ty * sz)++offsetPlusE :: Offset ty -> CountOf ty -> Offset ty+offsetPlusE (Offset ofs) (CountOf sz) = Offset (ofs + sz)++offsetMinusE :: Offset ty -> CountOf ty -> Offset ty+offsetMinusE (Offset ofs) (CountOf sz) = Offset (ofs - sz)++-- | subtract 2 CountOf values of the same type.+--+-- m need to be greater than n, otherwise negative count error ensue+-- use the safer (-) version if unsure.+offsetSub :: Offset a -> Offset a -> Offset a+offsetSub (Offset m) (Offset n) = Offset (m - n)++offsetRecast :: CountOf Word8 -> CountOf Word8 -> Offset ty -> Offset ty2+offsetRecast szTy (CountOf szTy2) ofs =+    let (Offset bytes) = offsetOfE szTy ofs+     in Offset (bytes `div` szTy2)++offsetShiftR :: Int -> Offset ty -> Offset ty2+offsetShiftR n (Offset o) = Offset (o `unsafeShiftR` n)++offsetShiftL :: Int -> Offset ty -> Offset ty2+offsetShiftL n (Offset o) = Offset (o `unsafeShiftL` n)++offsetCast :: Proxy (a -> b) -> Offset a -> Offset b+offsetCast _ (Offset o) = Offset o+{-# INLINE offsetCast #-}++sizeCast :: Proxy (a -> b) -> CountOf a -> CountOf b+sizeCast _ (CountOf sz) = CountOf sz+{-# INLINE sizeCast #-}++-- | subtract 2 CountOf values of the same type.+--+-- m need to be greater than n, otherwise negative count error ensue+-- use the safer (-) version if unsure.+sizeSub :: CountOf a -> CountOf a -> CountOf a+sizeSub (CountOf m) (CountOf n)+    | diff >= 0 = CountOf diff+    | otherwise = error "sizeSub negative size"+  where+    diff = m - n++-- TODO add a callstack, or a construction to prevent size == 0 error+sizeLastOffset :: CountOf a -> Offset a+sizeLastOffset (CountOf s)+    | s > 0     = Offset (pred s)+    | otherwise = error "last offset on size 0"++sizeAsOffset :: CountOf a -> Offset a+sizeAsOffset (CountOf a) = Offset a+{-# INLINE sizeAsOffset #-}++offsetAsSize :: Offset a -> CountOf a+offsetAsSize (Offset a) = CountOf a+{-# INLINE offsetAsSize #-}++-- | CountOf of a data structure.+--+-- More specifically, it represents the number of elements of type `ty` that fit+-- into the data structure.+--+-- >>> length (fromList ['a', 'b', 'c', '🌟']) :: CountOf Char+-- CountOf 4+--+-- Same caveats as 'Offset' apply here.+newtype CountOf ty = CountOf Int+    deriving (Show,Eq,Ord,Enum,Typeable,Integral)++instance Prelude.Num (CountOf ty) where+    fromInteger a = CountOf (fromInteger a)+    (+) (CountOf a) (CountOf b) = CountOf (a+b)+    (-) (CountOf a) (CountOf b)+        | b > a     = CountOf 0+        | otherwise = CountOf (a - b)+    (*) (CountOf a) (CountOf b) = CountOf (a*b)+    abs a = a+    negate _ = error "cannot negate CountOf: use Foundation Numerical hierarchy for this function to not be exposed to CountOf"+    signum (CountOf a) = CountOf (Prelude.signum a)++instance IsIntegral (CountOf ty) where+    toInteger (CountOf i) = toInteger i+instance IsNatural (CountOf ty) where+    toNatural (CountOf i) = toNatural (intToWord i)++instance Additive (CountOf ty) where+    azero = CountOf 0+    (+) (CountOf a) (CountOf b) = CountOf (a+b)+    scale n (CountOf a) = CountOf (scale n a)++instance Subtractive (CountOf ty) where+    type Difference (CountOf ty) = Maybe (CountOf ty)+    (CountOf a) - (CountOf b) | a >= b    = Just . CountOf $ a - b+                              | otherwise = Nothing++instance Semigroup (CountOf ty) where+    (<>) = (+)++instance Monoid (CountOf ty) where+    mempty = azero+    mappend = (+)+    mconcat = foldl' (+) 0++sizeOfE :: CountOf Word8 -> CountOf ty -> CountOf Word8+sizeOfE (CountOf sz) (CountOf ty) = CountOf (ty * sz)++-- | alignment need to be a power of 2+countOfRoundUp :: Int -> CountOf ty -> CountOf ty+countOfRoundUp alignment (CountOf n) = CountOf ((n + (alignment-1)) .&. complement (alignment-1))++-- when #if WORD_SIZE_IN_BITS < 64 the 2 following are wrong+-- instead of using FromIntegral and being silently wrong+-- explicit pattern match to sort it out.++csizeOfSize :: CountOf Word8 -> CSize+#if WORD_SIZE_IN_BITS < 64+csizeOfSize (CountOf (I# sz)) = CSize (W32# (int2Word# sz))+#else+csizeOfSize (CountOf (I# sz)) = CSize (W64# (int2Word# sz))+#endif++csizeOfOffset :: Offset8 -> CSize+#if WORD_SIZE_IN_BITS < 64+csizeOfOffset (Offset (I# sz)) = CSize (W32# (int2Word# sz))+#else+csizeOfOffset (Offset (I# sz)) = CSize (W64# (int2Word# sz))+#endif++sizeOfCSSize :: CSsize -> CountOf Word8+sizeOfCSSize (CSsize (-1))      = error "invalid size: CSSize is -1"+#if WORD_SIZE_IN_BITS < 64+sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# sz)+#else+sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# sz)+#endif++sizeOfCSize :: CSize -> CountOf Word8+#if WORD_SIZE_IN_BITS < 64+sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# sz))+#else+sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# sz))+#endif++natValCountOf :: forall n ty proxy . (KnownNat n, NatWithinBound (CountOf ty) n) => proxy n -> CountOf ty+natValCountOf n = CountOf $ Prelude.fromIntegral (natVal n)++natValOffset :: forall n ty proxy . (KnownNat n, NatWithinBound (Offset ty) n) => proxy n -> Offset ty+natValOffset n = Offset $ Prelude.fromIntegral (natVal n)++type instance NatNumMaxBound (CountOf x) = NatNumMaxBound Int+type instance NatNumMaxBound (Offset x) = NatNumMaxBound Int++type Countable ty n = NatWithinBound (CountOf ty) n+type Offsetable ty n = NatWithinBound (Offset ty) n
+ Basement/Types/Ptr.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE MagicHash #-}+module Basement.Types.Ptr+    ( Addr(..)+    , addrPlus+    , addrPlusSz+    , addrPlusCSz+    , Ptr(..)+    , ptrPlus+    , ptrPlusSz+    , ptrPlusCSz+    , castPtr+    ) where++import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Types.OffsetSize+import           GHC.Ptr+import           GHC.Prim+import           GHC.Types++data Addr = Addr Addr#+    deriving (Eq,Ord)++addrPlus :: Addr -> Offset Word8 -> Addr+addrPlus (Addr addr) (Offset (I# i)) = Addr (plusAddr# addr i)++addrPlusSz :: Addr -> CountOf Word8 -> Addr+addrPlusSz (Addr addr) (CountOf (I# i)) = Addr (plusAddr# addr i)++addrPlusCSz :: Addr -> CSize -> Addr+addrPlusCSz addr = addrPlusSz addr . sizeOfCSize++ptrPlus :: Ptr a -> Offset Word8 -> Ptr a+ptrPlus (Ptr addr) (Offset (I# i)) = Ptr (plusAddr# addr i)++ptrPlusSz :: Ptr a -> CountOf Word8 -> Ptr a+ptrPlusSz (Ptr addr) (CountOf (I# i)) = Ptr (plusAddr# addr i)++ptrPlusCSz :: Ptr a -> CSize -> Ptr a+ptrPlusCSz ptr = ptrPlusSz ptr . sizeOfCSize
+ Basement/Types/Word128.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE MagicHash          #-}+{-# LANGUAGE UnboxedTuples      #-}+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Basement.Types.Word128+    ( Word128(..)+    , (+)+    , (-)+    , (*)+    , quot+    , rem+    , bitwiseAnd+    , bitwiseOr+    , bitwiseXor+    , complement+    , shiftL+    , shiftR+    , rotateL+    , rotateR+    , popCount+    , fromNatural+    ) where++import           GHC.Prim+import           GHC.Word+import           GHC.Types+import qualified Prelude (fromInteger, show, Num(..), quot, rem, mod)+import           Data.Bits hiding (complement, popCount, bit, testBit+                                  , rotateL, rotateR, shiftL, shiftR)+import qualified Data.Bits as Bits+import           Data.Function (on)+import           Foreign.C+import           Foreign.Ptr+import           Foreign.Storable++import           Basement.Compat.Base+import           Basement.Compat.Natural+import           Basement.Compat.Primitive (bool#)+import           Basement.Numerical.Conversion+import           Basement.Numerical.Number++#include "MachDeps.h"++-- | 128 bits Word+data Word128 = Word128 {-# UNPACK #-} !Word64+                       {-# UNPACK #-} !Word64+    deriving (Eq, Typeable)++instance Show Word128 where+    show w = Prelude.show (toNatural w)+instance Enum Word128 where+    toEnum i = Word128 0 $ int64ToWord64 (intToInt64 i)+    fromEnum (Word128 _ a0) = wordToInt (word64ToWord a0)+    succ (Word128 a1 a0)+        | a0 == maxBound = Word128 (succ a1) 0+        | otherwise      = Word128 a1        (succ a0)+    pred (Word128 a1 a0)+        | a0 == minBound = Word128 (pred a1) maxBound+        | otherwise      = Word128 a1        (pred a0)+instance Bounded Word128 where+    minBound = Word128 minBound minBound+    maxBound = Word128 maxBound maxBound+instance Ord Word128 where+    compare (Word128 a1 a0) (Word128 b1 b0) =+        case compare a1 b1 of+            EQ -> compare a0 b0+            r  -> r+    (<) (Word128 a1 a0) (Word128 b1 b0) =+        case compare a1 b1 of+            EQ -> a0 < b0+            r  -> r == LT+    (<=) (Word128 a1 a0) (Word128 b1 b0) =+        case compare a1 b1 of+            EQ -> a0 <= b0+            r  -> r == LT+instance Storable Word128 where+    sizeOf _ = 16+    alignment _ = 16+    peek p = Word128 <$> peek (castPtr p            )+                     <*> peek (castPtr p `plusPtr` 8)+    poke p (Word128 a1 a0) = do+        poke (castPtr p            ) a1+        poke (castPtr p `plusPtr` 8) a0++instance Integral Word128 where+    fromInteger = literal+instance HasNegation Word128 where+    negate = complement++instance IsIntegral Word128 where+    toInteger (Word128 a1 a0) =+        (toInteger a1 `unsafeShiftL` 64) .|.+        toInteger a0+instance IsNatural Word128 where+    toNatural (Word128 a1 a0) =+        (toNatural a1 `unsafeShiftL` 64) .|.+        toNatural a0++instance Prelude.Num Word128 where+    abs w = w+    signum w@(Word128 a1 a0)+        | a1 == 0 && a0 == 0 = w+        | otherwise          = Word128 0 1+    fromInteger = literal+    (+) = (+)+    (-) = (-)+    (*) = (*)++instance Bits.Bits Word128 where+    (.&.) = bitwiseAnd+    (.|.) = bitwiseOr+    xor   = bitwiseXor+    complement = complement+    shiftL = shiftL+    shiftR = shiftR+    rotateL = rotateL+    rotateR = rotateR+    bitSize _ = 128+    bitSizeMaybe _ = Just 128+    isSigned _ = False+    testBit = testBit+    bit = bit+    popCount = popCount++-- | Add 2 Word128+(+) :: Word128 -> Word128 -> Word128+#if WORD_SIZE_IN_BITS < 64+(+) = applyBiWordOnNatural (Prelude.+)+#else+(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# s0)+  where+    !(# carry, s0 #) = plusWord2# a0 b0+    s1               = plusWord# (plusWord# a1 b1) carry+#endif++-- temporary available until native operation available+applyBiWordOnNatural :: (Natural -> Natural -> Natural)+                     -> Word128+                     -> Word128+                     -> Word128+applyBiWordOnNatural f a b = fromNatural $ f (toNatural a) (toNatural b)++-- | Subtract 2 Word128+(-) :: Word128 -> Word128 -> Word128+(-) a b+    | a >= b    = applyBiWordOnNatural (Prelude.-) a b+    | otherwise = complement (applyBiWordOnNatural (Prelude.-) b a) + 1++-- | Multiplication+(*) :: Word128 -> Word128 -> Word128+(*) = applyBiWordOnNatural (Prelude.*)++-- | Division+quot :: Word128 -> Word128 -> Word128+quot = applyBiWordOnNatural Prelude.quot++-- | Modulo+rem :: Word128 -> Word128 -> Word128+rem = applyBiWordOnNatural Prelude.rem++-- | Bitwise and+bitwiseAnd :: Word128 -> Word128 -> Word128+bitwiseAnd (Word128 a1 a0) (Word128 b1 b0) =+    Word128 (a1 .&. b1) (a0 .&. b0)++-- | Bitwise or+bitwiseOr :: Word128 -> Word128 -> Word128+bitwiseOr (Word128 a1 a0) (Word128 b1 b0) =+    Word128 (a1 .|. b1) (a0 .|. b0)++-- | Bitwise xor+bitwiseXor :: Word128 -> Word128 -> Word128+bitwiseXor (Word128 a1 a0) (Word128 b1 b0) =+    Word128 (a1 `Bits.xor` b1) (a0 `Bits.xor` b0)++-- | Bitwise complement+complement :: Word128 -> Word128+complement (Word128 a1 a0) = Word128 (Bits.complement a1) (Bits.complement a0)++-- | Population count+popCount :: Word128 -> Int+popCount (Word128 a1 a0) = Bits.popCount a1 Prelude.+ Bits.popCount a0++-- | Bitwise Shift Left+shiftL :: Word128 -> Int -> Word128+shiftL w@(Word128 a1 a0) n+    | n < 0 || n > 127 = Word128 0 0+    | n == 64          = Word128 a0 0+    | n == 0           = w+    | n >  64          = Word128 (a0 `Bits.unsafeShiftL` (n Prelude.- 64)) 0+    | otherwise        = Word128 ((a1 `Bits.unsafeShiftL` n) .|. (a0 `Bits.unsafeShiftR` (64 Prelude.- n)))+                                 (a0 `Bits.unsafeShiftL` n)++-- | Bitwise Shift Right+shiftR :: Word128 -> Int -> Word128+shiftR w@(Word128 a1 a0) n+    | n < 0 || n > 127 = Word128 0 0+    | n == 64          = Word128 0 a1+    | n == 0           = w+    | n >  64          = Word128 0 (a1 `Bits.unsafeShiftR` (n Prelude.- 64))+    | otherwise        = Word128 (a1 `Bits.unsafeShiftR` n)+                                 ((a1 `Bits.unsafeShiftL` (inv64 n)) .|. (a0 `Bits.unsafeShiftR` n))++-- | Bitwise rotate Left+rotateL :: Word128 -> Int -> Word128+rotateL (Word128 a1 a0) n'+    | n == 0    = Word128 a1 a0+    | n == 64   = Word128 a0 a1+    | n < 64    = Word128 (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a1 (inv64 n))+    | otherwise = let nx = n Prelude.- 64 in Word128 (comb64 a0 nx a1 (inv64 nx)) (comb64 a1 n' a0 (inv64 nx))+  where+    n :: Int+    n | n' >= 0   = n' `Prelude.mod` 128+      | otherwise = 128 Prelude.- (n' `Prelude.mod` 128)++-- | Bitwise rotate Left+rotateR :: Word128 -> Int -> Word128+rotateR w n = rotateL w (128 Prelude.- n)++inv64 :: Int -> Int+inv64 i = 64 Prelude.- i++comb64 :: Word64 -> Int -> Word64 -> Int -> Word64+comb64 x i y j =+    (x `Bits.unsafeShiftL` i) .|. (y `Bits.unsafeShiftR` j)++-- | Test bit+testBit :: Word128 -> Int -> Bool+testBit (Word128 a1 a0) n+    | n < 0 || n > 127 = False+    | n > 63           = Bits.testBit a1 (n Prelude.- 64)+    | otherwise        = Bits.testBit a0 n++-- | bit+bit :: Int -> Word128+bit n+    | n < 0 || n > 127 = Word128 0 0+    | n > 63           = Word128 (Bits.bit (n Prelude.- 64)) 0+    | otherwise        = Word128 0 (Bits.bit n)++literal :: Integer -> Word128+literal i = Word128+    (Prelude.fromInteger (i `Bits.unsafeShiftR` 64))+    (Prelude.fromInteger i)++fromNatural :: Natural -> Word128+fromNatural n = Word128+    (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 64))+    (Prelude.fromInteger $ naturalToInteger n)
+ Basement/Types/Word256.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE MagicHash          #-}+{-# LANGUAGE UnboxedTuples      #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Basement.Types.Word256+    ( Word256(..)+    , (+)+    , (-)+    , (*)+    , quot+    , rem+    , bitwiseAnd+    , bitwiseOr+    , bitwiseXor+    , complement+    , shiftL+    , shiftR+    , rotateL+    , rotateR+    , popCount+    , fromNatural+    ) where++import           GHC.Prim+import           GHC.Word+import           GHC.Types+import qualified Prelude (fromInteger, show, Num(..), quot, rem, mod)+import           Data.Bits hiding (complement, popCount, bit, testBit+                                  , rotateL, rotateR, shiftL, shiftR)+import qualified Data.Bits as Bits+import           Data.Function (on)+import           Foreign.C+import           Foreign.Ptr+import           Foreign.Storable++import           Basement.Compat.Base+import           Basement.Compat.Natural+import           Basement.Compat.Primitive (bool#)+import           Basement.Numerical.Conversion+import           Basement.Numerical.Number++#include "MachDeps.h"++-- | 256 bits Word+data Word256 = Word256 {-# UNPACK #-} !Word64+                       {-# UNPACK #-} !Word64+                       {-# UNPACK #-} !Word64+                       {-# UNPACK #-} !Word64+    deriving (Eq, Typeable)++instance Show Word256 where+    show w = Prelude.show (toNatural w)+instance Enum Word256 where+    toEnum i = Word256 0 0 0 $ int64ToWord64 (intToInt64 i)+    fromEnum (Word256 _ _ _ a0) = wordToInt (word64ToWord a0)+    succ (Word256 a3 a2 a1 a0)+        | a0 == maxBound =+            if a1 == maxBound+                then if a2 == maxBound+                        then Word256 (succ a3) 0 0 0+                        else Word256 a3 (succ a2) 0 0+                else Word256 a3 a2 (succ a1) 0+        | otherwise      = Word256 a3 a2 a1        (succ a0)+    pred (Word256 a3 a2 a1 a0)+        | a0 == minBound =+            if a1 == minBound+                then if a2 == minBound+                        then Word256 (pred a3) maxBound maxBound maxBound+                        else Word256 a3 (pred a2) maxBound maxBound+                else Word256 a3 a2 (pred a1) maxBound+        | otherwise      = Word256 a3 a2 a1        (pred a0)+instance Bounded Word256 where+    minBound = Word256 minBound minBound minBound minBound+    maxBound = Word256 maxBound maxBound maxBound maxBound+instance Ord Word256 where+    compare (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =+        compareEq a3 b3 $ compareEq a2 b2 $ compareEq a1 b1 $ compare a0 b0+      where compareEq x y next =+                case compare x y of+                    EQ -> next+                    r  -> r+    (<) (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =+        compareLt a3 b3 $ compareLt a2 b2 $ compareLt a1 b1 (a0 < b0)+      where compareLt x y next =+                case compare x y of+                    EQ -> next+                    r  -> r == LT+instance Storable Word256 where+    sizeOf _ = 32+    alignment _ = 32+    peek p = Word256 <$> peek (castPtr p            )+                     <*> peek (castPtr p `plusPtr` 8)+                     <*> peek (castPtr p `plusPtr` 16)+                     <*> peek (castPtr p `plusPtr` 24)+    poke p (Word256 a3 a2 a1 a0) = do+        poke (castPtr p             ) a3+        poke (castPtr p `plusPtr` 8 ) a2+        poke (castPtr p `plusPtr` 16) a1+        poke (castPtr p `plusPtr` 24) a0++instance Integral Word256 where+    fromInteger = literal+instance HasNegation Word256 where+    negate = complement++instance IsIntegral Word256 where+    toInteger (Word256 a3 a2 a1 a0) =+        (toInteger a3 `Bits.unsafeShiftL` 192) Bits..|.+        (toInteger a2 `Bits.unsafeShiftL` 128) Bits..|.+        (toInteger a1 `Bits.unsafeShiftL` 64) Bits..|.+        toInteger a0+instance IsNatural Word256 where+    toNatural (Word256 a3 a2 a1 a0) =+        (toNatural a3 `Bits.unsafeShiftL` 192) Bits..|.+        (toNatural a2 `Bits.unsafeShiftL` 128) Bits..|.+        (toNatural a1 `Bits.unsafeShiftL` 64) Bits..|.+        toNatural a0++instance Prelude.Num Word256 where+    abs w = w+    signum w@(Word256 a3 a2 a1 a0)+        | a3 == 0 && a2 == 0 && a1 == 0 && a0 == 0 = w+        | otherwise                                = Word256 0 0 0 1+    fromInteger = literal+    (+) = (+)+    (-) = (-)+    (*) = (*)++instance Bits.Bits Word256 where+    (.&.) = bitwiseAnd+    (.|.) = bitwiseOr+    xor   = bitwiseXor+    complement = complement+    shiftL = shiftL+    shiftR = shiftR+    rotateL = rotateL+    rotateR = rotateR+    bitSize _ = 256+    bitSizeMaybe _ = Just 256+    isSigned _ = False+    testBit = testBit+    bit = bit+    popCount = popCount++-- | Add 2 Word256+(+) :: Word256 -> Word256 -> Word256+#if WORD_SIZE_IN_BITS < 64+(+) = applyBiWordOnNatural (Prelude.+)+#else+(+) (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0))+    (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) =+    Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0)+  where+    !(# c0, s0 #) = plusWord2# a0 b0+    !(# c1, s1 #) = plusWord3# a1 b1 c0+    !(# c2, s2 #) = plusWord3# a2 b2 c1+    !s3           = plusWord3NoCarry# a3 b3 c2++    plusWord3NoCarry# a b c = plusWord# (plusWord# a b) c+    plusWord3# a b c+        | bool# (eqWord# carry 0##) = plusWord2# x c+        | otherwise                 =+            case plusWord2# x c of+                (# carry2, x' #)+                    | bool# (eqWord# carry2 0##) -> (# carry, x' #)+                    | otherwise                  -> (# plusWord# carry carry2, x' #)+      where+        (# carry, x #) = plusWord2# a b+#endif++-- temporary available until native operation available+applyBiWordOnNatural :: (Natural -> Natural -> Natural)+                     -> Word256+                     -> Word256+                     -> Word256+applyBiWordOnNatural f = (fromNatural .) . (f `on` toNatural)++-- | Subtract 2 Word256+(-) :: Word256 -> Word256 -> Word256+(-) a b+    | a >= b    = applyBiWordOnNatural (Prelude.-) a b+    | otherwise = complement (applyBiWordOnNatural (Prelude.-) b a) + 1++-- | Multiplication+(*) :: Word256 -> Word256 -> Word256+(*) = applyBiWordOnNatural (Prelude.*)++-- | Division+quot :: Word256 -> Word256 -> Word256+quot = applyBiWordOnNatural Prelude.quot++-- | Modulo+rem :: Word256 -> Word256 -> Word256+rem = applyBiWordOnNatural Prelude.rem++-- | Bitwise and+bitwiseAnd :: Word256 -> Word256 -> Word256+bitwiseAnd (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =+    Word256 (a3 Bits..&. b3) (a2 Bits..&. b2)  (a1 Bits..&. b1) (a0 Bits..&. b0)++-- | Bitwise or+bitwiseOr :: Word256 -> Word256 -> Word256+bitwiseOr (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =+    Word256 (a3 Bits..|. b3) (a2 Bits..|. b2)  (a1 Bits..|. b1) (a0 Bits..|. b0)++-- | Bitwise xor+bitwiseXor :: Word256 -> Word256 -> Word256+bitwiseXor (Word256 a3 a2 a1 a0) (Word256 b3 b2 b1 b0) =+    Word256 (a3 `Bits.xor` b3) (a2 `Bits.xor` b2)  (a1 `Bits.xor` b1) (a0 `Bits.xor` b0)++-- | Bitwise complement+complement :: Word256 -> Word256+complement (Word256 a3 a2 a1 a0) =+    Word256 (Bits.complement a3) (Bits.complement a2) (Bits.complement a1) (Bits.complement a0)++-- | Population count+popCount :: Word256 -> Int+popCount (Word256 a3 a2 a1 a0) =+    Bits.popCount a3 Prelude.++    Bits.popCount a2 Prelude.++    Bits.popCount a1 Prelude.++    Bits.popCount a0++-- | Bitwise Shift Left+shiftL :: Word256 -> Int -> Word256+shiftL w@(Word256 a3 a2 a1 a0) n+    | n < 0 || n > 255 = Word256 0 0 0 0+    | n == 0           = w+    | n == 64          = Word256 a2 a1 a0 0+    | n == 128         = Word256 a1 a0 0 0+    | n == 192         = Word256 a0 0 0 0+    | n < 64           = mkWordShift a3 a2 a1 a0 n+    | n < 128          = mkWordShift a2 a1 a0 0  (n Prelude.- 64)+    | n < 192          = mkWordShift a1 a0 0  0  (n Prelude.- 128)+    | otherwise        = mkWordShift a0 0  0  0  (n Prelude.- 192)+  where+    mkWordShift :: Word64 -> Word64 -> Word64 -> Word64 -> Int -> Word256+    mkWordShift w x y z s =+        Word256 (comb64 w s x s') (comb64 x s y s') (comb64 y s z s') (z `Bits.unsafeShiftL` s)+      where s' = inv64 s++-- | Bitwise Shift Right+shiftR :: Word256 -> Int -> Word256+shiftR w@(Word256 a3 a2 a1 a0) n+    | n < 0 || n > 255 = Word256 0 0 0 0+    | n == 0           = w+    | n == 64          = Word256 0 a3 a2 a1+    | n == 128         = Word256 0 0 a3 a2+    | n == 192         = Word256 0 0 0 a3+    | n <  64          = mkWordShift a3 a2 a1 a0 n+    | n < 128          = mkWordShift  0 a3 a2 a1 (n Prelude.- 64)+    | n < 192          = mkWordShift  0  0 a3 a2 (n Prelude.- 128)+    | otherwise        = Word256 0 0 0 (a3 `Bits.unsafeShiftR` (n Prelude.- 192))+  where+    mkWordShift :: Word64 -> Word64 -> Word64 -> Word64 -> Int -> Word256+    mkWordShift w x y z s =+        Word256 (w `Bits.unsafeShiftR` s) (comb64 w s' x s) (comb64 x s' y s) (comb64 y s' z s)+      where s' = inv64 s++-- | Bitwise rotate Left+rotateL :: Word256 -> Int -> Word256+rotateL (Word256 a3 a2 a1 a0) n'+    | n == 0    = Word256 a3 a2 a1 a0+    | n == 192  = Word256 a0 a3 a2 a1+    | n == 128  = Word256 a1 a0 a3 a2+    | n == 64   = Word256 a2 a1 a0 a3+    | n < 64    = Word256 (comb64 a3 n a2 (inv64 n)) (comb64 a2 n a1 (inv64 n))+                          (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a3 (inv64 n))+    | n < 128   = let n = n Prelude.- 64 in Word256+                          (comb64 a2 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n))+                          (comb64 a0 n a3 (inv64 n)) (comb64 a3 n a2 (inv64 n))+    | n < 192   = let n = n Prelude.- 128 in Word256+                          (comb64 a1 n a0 (inv64 n)) (comb64 a0 n a3 (inv64 n))+                          (comb64 a3 n a2 (inv64 n)) (comb64 a2 n a1 (inv64 n))+    | otherwise = let n = n Prelude.- 192 in Word256+                          (comb64 a0 n a3 (inv64 n)) (comb64 a3 n a2 (inv64 n))+                          (comb64 a2 n a1 (inv64 n)) (comb64 a1 n a0 (inv64 n))+  where+    n :: Int+    n | n' >= 0   = n' `Prelude.mod` 256+      | otherwise = 256 Prelude.- (n' `Prelude.mod` 256)++-- | Bitwise rotate Left+rotateR :: Word256 -> Int -> Word256+rotateR w n = rotateL w (256 Prelude.- n)++inv64 :: Int -> Int+inv64 i = 64 Prelude.- i++comb64 :: Word64 -> Int -> Word64 -> Int -> Word64+comb64 x i y j =+    (x `Bits.unsafeShiftL` i) .|. (y `Bits.unsafeShiftR` j)++-- | Test bit+testBit :: Word256 -> Int -> Bool+testBit (Word256 a3 a2 a1 a0) n+    | n < 0 || n > 255 = False+    | n > 191          = Bits.testBit a3 (n Prelude.- 192)+    | n > 127          = Bits.testBit a2 (n Prelude.- 128)+    | n > 63           = Bits.testBit a1 (n Prelude.- 64)+    | otherwise        = Bits.testBit a0 n++-- | bit+bit :: Int -> Word256+bit n+    | n < 0 || n > 255 = Word256 0 0 0 0+    | n > 191          = Word256 (Bits.bit (n Prelude.- 192)) 0 0 0+    | n > 127          = Word256 0 (Bits.bit (n Prelude.- 128)) 0 0+    | n > 63           = Word256 0 0 (Bits.bit (n Prelude.- 64)) 0+    | otherwise        = Word256 0 0 0 (Bits.bit n)++literal :: Integer -> Word256+literal i = Word256+    (Prelude.fromInteger (i `Bits.unsafeShiftR` 192))+    (Prelude.fromInteger (i `Bits.unsafeShiftR` 128))+    (Prelude.fromInteger (i `Bits.unsafeShiftR` 64))+    (Prelude.fromInteger i)++fromNatural :: Natural -> Word256+fromNatural n = Word256+    (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 192))+    (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 128))+    (Prelude.fromInteger (naturalToInteger n `Bits.unsafeShiftR` 64))+    (Prelude.fromInteger $ naturalToInteger n)
+ Basement/UArray.hs view
@@ -0,0 +1,942 @@+-- |+-- Module      : Basement.UArray+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- An unboxed array of primitive types+--+-- All the cells in the array are in one chunk of contiguous+-- memory.+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Basement.UArray+    ( UArray(..)+    , PrimType(..)+    -- * methods+    , copy+    , unsafeCopyAtRO+    -- * internal methods+    -- , copyAddr+    , recast+    , unsafeRecast+    , length+    , freeze+    , unsafeFreeze+    , thaw+    , unsafeThaw+    -- * Creation+    , vFromListN+    , new+    , create+    , createFromIO+    , createFromPtr+    , sub+    , copyToPtr+    , withPtr+    , withMutablePtr+    , unsafeFreezeShrink+    , freezeShrink+    , fromBlock+    , toBlock+    -- * accessors+    , update+    , unsafeUpdate+    , unsafeIndex+    , unsafeIndexer+    , unsafeDewrap+    , unsafeRead+    , unsafeWrite+    -- * Functions+    , equalMemcmp+    , singleton+    , replicate+    , map+    , mapIndex+    , findIndex+    , revFindIndex+    , index+    , null+    , take+    , unsafeTake+    , drop+    , unsafeDrop+    , splitAt+    , revDrop+    , revTake+    , revSplitAt+    , splitOn+    , break+    , breakEnd+    , breakElem+    , breakLine+    , elem+    , indices+    , intersperse+    , span+    , spanEnd+    , cons+    , snoc+    , uncons+    , unsnoc+    , find+    , sortBy+    , filter+    , reverse+    , replace+    , foldr+    , foldl'+    , foldr1+    , foldl1'+    , all+    , any+    , isPrefixOf+    , isSuffixOf+    , foreignMem+    , fromForeignPtr+    , builderAppend+    , builderBuild+    , builderBuild_+    , toHexadecimal+    , toBase64Internal+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.Word+import           GHC.ST+import           GHC.Ptr+import           GHC.ForeignPtr (ForeignPtr)+import           Foreign.Marshal.Utils (copyBytes)+import           Basement.Compat.Base+import           Basement.Compat.Primitive+import           Data.Proxy+import           Basement.Types.OffsetSize+import           Basement.Compat.MonadTrans+import           Basement.NonEmpty+import           Basement.Monad+import           Basement.PrimType+import           Basement.FinalPtr+import           Basement.Exception+import           Basement.UArray.Base+import           Basement.Block (Block(..), MutableBlock(..))+import qualified Basement.Block as BLK+import qualified Basement.Block.Base as BLK (withPtr, unsafeWrite)+import           Basement.UArray.Mutable hiding (sub, copyToPtr)+import           Basement.Numerical.Additive+import           Basement.Numerical.Subtractive+import           Basement.Numerical.Multiplicative+import           Basement.MutableBuilder+import           Basement.Bindings.Memory (sysHsMemFindByteBa, sysHsMemFindByteAddr)+import qualified Basement.Compat.ExtList as List+import qualified Basement.Base16 as Base16+import qualified Basement.Alg.Mutable as Alg+import qualified Basement.Alg.Class as Alg+import qualified Basement.Alg.PrimArray as Alg+import           Basement.HeadHackageUtils++-- | Return the element at a specific index from an array.+--+-- If the index @n is out of bounds, an error is raised.+index :: PrimType ty => UArray ty -> Offset ty -> ty+index array n+    | isOutOfBound n len = outOfBound OOB_Index n len+    | otherwise          = unsafeIndex array n+  where+    !len = length array+{-# INLINE index #-}++foreignMem :: PrimType ty+           => FinalPtr ty -- ^ the start pointer with a finalizer+           -> CountOf ty  -- ^ the number of elements (in elements, not bytes)+           -> UArray ty+foreignMem fptr nb = UArray (Offset 0) nb (UArrayAddr fptr)++-- | Create a foreign UArray from foreign memory and given offset/size+--+-- No check are performed to make sure this is valid, so this is unsafe.+--+-- This is particularly useful when dealing with foreign memory and+-- 'ByteString'+fromForeignPtr :: PrimType ty+               => (ForeignPtr ty, Int, Int) -- ForeignPtr, an offset in prim elements, a size in prim elements+               -> UArray ty+fromForeignPtr (fptr, ofs, len) = UArray (Offset ofs) (CountOf len) (UArrayAddr $ toFinalPtrForeign fptr)+++-- | Create a UArray from a Block+--+-- The block is still used by the uarray+fromBlock :: PrimType ty+          => Block ty+          -> UArray ty+fromBlock blk = UArray 0 (BLK.length blk) (UArrayBA blk)++-- | Allocate a new array with a fill function that has access to the elements of+--   the source array.+unsafeCopyFrom :: (PrimType a, PrimType b)+               => UArray a -- ^ Source array+               -> CountOf b -- ^ Length of the destination array+               -> (UArray a -> Offset a -> MUArray b s -> ST s ())+               -- ^ Function called for each element in the source array+               -> ST s (UArray b) -- ^ Returns the filled new array+unsafeCopyFrom v' newLen f = new newLen >>= fill 0 >>= unsafeFreeze+  where len = length v'+        fill i r'+            | i .==# len = pure r'+            | otherwise  = do f v' i r'+                              fill (i + 1) r'++-- | Freeze a MUArray into a UArray by copying all the content is a pristine new buffer+--+-- The MUArray in parameter can be still be used after the call without+-- changing the resulting frozen data.+freeze :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> prim (UArray ty)+freeze ma = do+    ma' <- new len+    copyAt ma' (Offset 0) ma (Offset 0) len+    unsafeFreeze ma'+  where len = mutableLength ma++-- | Just like 'freeze' but copy only the first n bytes+--+-- The size requested need to be smaller or equal to the length+-- of the MUArray, otherwise a Out of Bounds exception is raised+freezeShrink :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)+freezeShrink ma n = do+    when (n > mutableLength ma) $ primOutOfBound OOB_MemCopy (sizeAsOffset n) (mutableLength ma)+    ma' <- new n+    copyAt ma' (Offset 0) ma (Offset 0) n+    unsafeFreeze ma'++-- | Create a new array of size @n by settings each cells through the+-- function @f.+create :: forall ty . PrimType ty+       => CountOf ty           -- ^ the size of the array+       -> (Offset ty -> ty) -- ^ the function that set the value at the index+       -> UArray ty         -- ^ the array created+create n initializer+    | n == 0    = mempty+    | otherwise = runST (new n >>= iter initializer)+  where+    iter :: (PrimType ty, PrimMonad prim) => (Offset ty -> ty) -> MUArray ty (PrimState prim) -> prim (UArray ty)+    iter f ma = loop 0+      where+        loop i+            | i .==# n  = unsafeFreeze ma+            | otherwise = unsafeWrite ma i (f i) >> loop (i+1)+        {-# INLINE loop #-}+    {-# INLINE iter #-}++-- | Create a pinned array that is filled by a 'filler' function (typically an IO call like hGetBuf)+createFromIO :: PrimType ty+             => CountOf ty                  -- ^ the size of the array+             -> (Ptr ty -> IO (CountOf ty)) -- ^ filling function that+             -> IO (UArray ty)+createFromIO size filler+    | size == 0 = pure mempty+    | otherwise = do+        mba <- newPinned size+        r   <- withMutablePtr mba $ \p -> filler p+        case r of+            0             -> pure mempty -- make sure we don't keep our array referenced by using empty+            _ | r < 0     -> error "filler returned negative number"+              | otherwise -> unsafeFreezeShrink mba r++-- | Freeze a chunk of memory pointed, of specific size into a new unboxed array+createFromPtr :: PrimType ty+              => Ptr ty+              -> CountOf ty+              -> IO (UArray ty)+createFromPtr p s = do+    ma <- new s+    copyFromPtr p s ma+    unsafeFreeze ma++-----------------------------------------------------------------------+-- higher level collection implementation+-----------------------------------------------------------------------++singleton :: PrimType ty => ty -> UArray ty+singleton ty = create 1 (const ty)++replicate :: PrimType ty => CountOf ty -> ty -> UArray ty+replicate sz ty = create sz (const ty)++-- | update an array by creating a new array with the updates.+--+-- the operation copy the previous array, modify it in place, then freeze it.+update :: PrimType ty+       => UArray ty+       -> [(Offset ty, ty)]+       -> UArray ty+update array modifiers = runST (thaw array >>= doUpdate modifiers)+  where doUpdate l ma = loop l+          where loop []         = unsafeFreeze ma+                loop ((i,v):xs) = write ma i v >> loop xs+                {-# INLINE loop #-}+        {-# INLINE doUpdate #-}++unsafeUpdate :: PrimType ty+             => UArray ty+             -> [(Offset ty, ty)]+             -> UArray ty+unsafeUpdate array modifiers = runST (thaw array >>= doUpdate modifiers)+  where doUpdate l ma = loop l+          where loop []         = unsafeFreeze ma+                loop ((i,v):xs) = unsafeWrite ma i v >> loop xs+                {-# INLINE loop #-}+        {-# INLINE doUpdate #-}++-- | Copy all the block content to the memory starting at the destination address+copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)+          => UArray ty -- ^ the source array to copy+          -> Ptr ty    -- ^ The destination address where the copy is going to start+          -> prim ()+copyToPtr arr dst@(Ptr dst#) = onBackendPrim copyBa copyPtr arr+  where+    !(Offset os@(I# os#)) = offsetInBytes $ offset arr+    !(CountOf szBytes@(I# szBytes#)) = sizeInBytes $ length arr+    copyBa (Block ba) = primitive $ \s1 -> (# copyByteArrayToAddr# ba os# dst# szBytes# s1, () #)+    copyPtr fptr = unsafePrimFromIO $ withFinalPtr fptr $ \ptr -> copyBytes dst (ptr `plusPtr` os) szBytes++-- | Get a Ptr pointing to the data in the UArray.+--+-- Since a UArray is immutable, this Ptr shouldn't be+-- to use to modify the contents+--+-- If the UArray is pinned, then its address is returned as is,+-- however if it's unpinned, a pinned copy of the UArray is made+-- before getting the address.+withPtr :: forall ty prim a . (PrimMonad prim, PrimType ty)+        => UArray ty+        -> (Ptr ty -> prim a)+        -> prim a+withPtr a f =+    onBackendPrim (\blk  -> BLK.withPtr  blk  $ \ptr -> f (ptr `plusPtr` os))+                  (\fptr -> withFinalPtr fptr $ \ptr -> f (ptr `plusPtr` os))+                  a+  where+    !sz          = primSizeInBytes (Proxy :: Proxy ty)+    !(Offset os) = offsetOfE sz $ offset a+{-# INLINE withPtr #-}++-- | Recast an array of type a to an array of b+--+-- a and b need to have the same size otherwise this+-- raise an async exception+recast :: forall a b . (PrimType a, PrimType b) => UArray a -> UArray b+recast array+    | aTypeSize == bTypeSize = unsafeRecast array+    | missing   == 0         = unsafeRecast array+    | otherwise = throw $ InvalidRecast+                      (RecastSourceSize      alen)+                      (RecastDestinationSize $ alen + missing)+  where+    aTypeSize = primSizeInBytes (Proxy :: Proxy a)+    bTypeSize@(CountOf bs) = primSizeInBytes (Proxy :: Proxy b)+    (CountOf alen) = sizeInBytes (length array)+    missing = alen `mod` bs++-- | Unsafely recast an UArray containing 'a' to an UArray containing 'b'+--+-- The offset and size are converted from units of 'a' to units of 'b',+-- but no check are performed to make sure this is compatible.+--+-- use 'recast' if unsure.+unsafeRecast :: (PrimType a, PrimType b) => UArray a -> UArray b+unsafeRecast (UArray start len backend) = UArray (primOffsetRecast start) (sizeRecast len) $+    case backend of+        UArrayAddr fptr     -> UArrayAddr (castFinalPtr fptr)+        UArrayBA (Block ba) -> UArrayBA (Block ba)+{-# INLINE [1] unsafeRecast #-}+{-# SPECIALIZE [3] unsafeRecast :: PrimType a => UArray Word8 -> UArray a #-}++null :: UArray ty -> Bool+null arr = length arr == 0++-- | Take a count of elements from the array and create an array with just those elements+take :: CountOf ty -> UArray ty -> UArray ty+take n arr@(UArray start len backend)+    | n <= 0    = empty+    | n >= len  = arr+    | otherwise = UArray start n backend++unsafeTake :: CountOf ty -> UArray ty -> UArray ty+unsafeTake sz (UArray start _ ba) = UArray start sz ba++-- | Drop a count of elements from the array and return the new array minus those dropped elements+drop :: CountOf ty -> UArray ty -> UArray ty+drop n arr@(UArray start len backend)+    | n <= 0                             = arr+    | Just newLen <- len - n, newLen > 0 = UArray (start `offsetPlusE` n) newLen backend+    | otherwise                          = empty++unsafeDrop :: CountOf ty -> UArray ty -> UArray ty+unsafeDrop n (UArray start sz backend) = UArray (start `offsetPlusE` n) (sz `sizeSub` n) backend++-- | Split an array into two, with a count of at most N elements in the first one+-- and the remaining in the other.+splitAt :: CountOf ty -> UArray ty -> (UArray ty, UArray ty)+splitAt nbElems arr@(UArray start len backend)+    | nbElems <= 0                               = (empty, arr)+    | Just nbTails <- len - nbElems, nbTails > 0 = (UArray start                         nbElems backend+                                                   ,UArray (start `offsetPlusE` nbElems) nbTails backend)+    | otherwise                                  = (arr, empty)+++breakElem :: PrimType ty => ty -> UArray ty -> (UArray ty, UArray ty)+breakElem !ty arr@(UArray start len backend)+    | k == sentinel = (arr, empty)+    | k == start    = (empty, arr)+    | otherwise     = (UArray start (offsetAsSize l1)       backend+                     , UArray k     (sizeAsOffset len - l1) backend)+  where+    !k = onBackendPure' arr $ Alg.findIndexElem ty+    l1 = k `offsetSub` start+{-# NOINLINE [3] breakElem #-}+{-# RULES "breakElem Word8" [4] breakElem = breakElemByte #-}+{-# SPECIALIZE [3] breakElem :: Word32 -> UArray Word32 -> (UArray Word32, UArray Word32) #-}++breakElemByte :: Word8 -> UArray Word8 -> (UArray Word8, UArray Word8)+breakElemByte !ty arr@(UArray start len backend)+    | k == end   = (arr, empty)+    | k == start = (empty, arr)+    | otherwise  = ( UArray start (offsetAsSize k `sizeSub` offsetAsSize start) backend+                   , UArray k     (len `sizeSub` (offsetAsSize k `sizeSub` offsetAsSize start)) backend)+  where+    !end = start `offsetPlusE` len+    !k = onBackendPure goBa goAddr arr+    goBa (Block ba) = sysHsMemFindByteBa ba start end ty+    goAddr (Ptr addr) = sysHsMemFindByteAddr addr start end ty++-- | Similar to breakElem specialized to split on linefeed+--+-- it either returns:+-- * Left. no line has been found, and whether the last character is a CR+-- * Right, a line has been found with an optional CR, and it returns+--   the array of bytes on the left of the CR/LF, and the+--   the array of bytes on the right of the LF.+--+breakLine :: UArray Word8 -> Either Bool (UArray Word8, UArray Word8)+breakLine arr@(UArray start len backend)+    | end == start = Left False+    | k2 == end    = Left (k1 /= k2)+    | otherwise    = let newArray start' len' = if len' == 0 then empty else UArray start' len' backend+                      in Right (newArray start (k1-start), newArray (k2+1) (end - (k2+1)))+  where+    !end = start `offsetPlusE` len+    -- return (offset of CR, offset of LF, whether the last element was a carriage return+    !(k1, k2) = onBackendPure goBa goAddr arr+    lineFeed = 0xa+    carriageReturn = 0xd+    goBa (Block ba) =+        let k = sysHsMemFindByteBa ba start end lineFeed+            cr = k > start && primBaIndex ba (k `offsetSub` 1) == carriageReturn+         in (if cr then k `offsetSub` 1 else k, k)+    goAddr (Ptr addr) =+        let k = sysHsMemFindByteAddr addr start end lineFeed+            cr = k > start && primAddrIndex addr (k `offsetSub` 1) == carriageReturn+         in (if cr then k `offsetSub` 1 else k, k)++-- inverse a CountOf that is specified from the end (e.g. take n elements from the end)+countFromStart :: UArray ty -> CountOf ty -> CountOf ty+countFromStart v sz@(CountOf sz')+    | sz >= len = CountOf 0+    | otherwise = CountOf (len' - sz')+  where len@(CountOf len') = length v++-- | Take the N elements from the end of the array+revTake :: CountOf ty -> UArray ty -> UArray ty+revTake n v = drop (countFromStart v n) v++-- | Drop the N elements from the end of the array+revDrop :: CountOf ty -> UArray ty -> UArray ty+revDrop n v = take (countFromStart v n) v++-- | Split an array at the N element from the end, and return+-- the last N elements in the first part of the tuple, and whatever first+-- elements remaining in the second+revSplitAt :: CountOf ty -> UArray ty -> (UArray ty, UArray ty)+revSplitAt n v = (drop sz v, take sz v) where sz = countFromStart v n++splitOn :: PrimType ty => (ty -> Bool) -> UArray ty -> [UArray ty]+splitOn xpredicate ivec+    | len == 0  = [mempty]+    | otherwise = runST $ unsafeIndexer ivec (pureST . go ivec xpredicate)+  where+    !len = length ivec+    go v predicate getIdx = loop 0 0+      where+        loop !prevIdx !idx+            | idx .==# len = [sub v prevIdx idx]+            | otherwise    =+                let e = getIdx idx+                    idx' = idx + 1+                 in if predicate e+                        then sub v prevIdx idx : loop idx' idx'+                        else loop prevIdx idx'+    {-# INLINE go #-}++sub :: PrimType ty => UArray ty -> Offset ty -> Offset ty -> UArray ty+sub (UArray start len backend) startIdx expectedEndIdx+    | startIdx >= endIdx = mempty+    | otherwise          = UArray (start + startIdx) newLen backend+  where+    newLen = endIdx - startIdx+    endIdx = min expectedEndIdx (0 `offsetPlusE` len)++findIndex :: PrimType ty => ty -> UArray ty -> Maybe (Offset ty)+findIndex ty arr+    | k == sentinel  = Nothing+    | otherwise      = Just (k `offsetSub` offset arr)+  where+    !k = onBackendPure' arr $ Alg.findIndexElem ty+{-# SPECIALIZE [3] findIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}++revFindIndex :: PrimType ty => ty -> UArray ty -> Maybe (Offset ty)+revFindIndex ty arr+    | k == sentinel = Nothing+    | otherwise     = Just (k `offsetSub` offset arr)+  where+    !k = onBackendPure' arr $ Alg.revFindIndexElem ty+{-# SPECIALIZE [3] revFindIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}++break :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)+break predicate arr+    | k == sentinel = (arr, mempty)+    | otherwise     = splitAt (k - offset arr) arr+  where+    !k = onBackendPure' arr $ Alg.findIndexPredicate predicate++{-+{-# SPECIALIZE [3] findIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}+    | len == 0  = (mempty, mempty)+    | otherwise = runST $ unsafeIndexer xv (go xv xpredicate)+  where+    !len = length xv+    go :: PrimType ty => UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> ST s (UArray ty, UArray ty)+    go v predicate getIdx = pure (findBreak $ Offset 0)+      where+        findBreak !i+            | i .==# len           = (v, mempty)+            | predicate (getIdx i) = splitAt (offsetAsSize i) v+            | otherwise            = findBreak (i + Offset 1)+        {-# INLINE findBreak #-}+    {-# INLINE go #-}+    -}+{-# NOINLINE [2] break #-}+{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> UArray Word8 -> (UArray Word8, UArray Word8) #-}++{-+{-# RULES "break (== ty)" [3] forall (x :: forall ty . PrimType ty => ty) . break (== x) = breakElem x #-}+{-# RULES "break (ty ==)" [3] forall (x :: forall ty . PrimType ty => ty) . break (x ==) = breakElem x #-}+{-# RULES "break (== ty)" [3] forall (x :: Word8) . break (== x) = breakElem x #-}+-}++-- | Similar to break but start the search of the breakpoint from the end+--+-- > breakEnd (> 0) [1,2,3,0,0,0]+-- ([1,2,3], [0,0,0])+breakEnd :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)+breakEnd predicate arr+    | k == sentinel = (arr, mempty)+    | otherwise     = splitAt ((k+1) - offset arr) arr+  where+    !k = onBackendPure' arr $ Alg.revFindIndexPredicate predicate+{-# SPECIALIZE [3] breakEnd :: (Word8 -> Bool) -> UArray Word8 -> (UArray Word8, UArray Word8) #-}++elem :: PrimType ty => ty -> UArray ty -> Bool+elem !ty arr = onBackendPure' arr (Alg.findIndexElem ty) /= sentinel+{-# SPECIALIZE [2] elem :: Word8 -> UArray Word8 -> Bool #-}++intersperse :: forall ty . PrimType ty => ty -> UArray ty -> UArray ty+intersperse sep v = case len - 1 of+    Nothing -> v+    Just 0 -> v+    Just gaps -> runST $ unsafeCopyFrom v (len + gaps) go+  where+    len = length v++    go :: PrimType ty => UArray ty -> Offset ty -> MUArray ty s -> ST s ()+    go oldV oldI newV+        | (oldI + 1) .==# len = unsafeWrite newV newI e+        | otherwise           = do+            unsafeWrite newV newI e+            unsafeWrite newV (newI + 1) sep+      where+        e = unsafeIndex oldV oldI+        newI = scale (2 :: Word) oldI++span :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)+span p = break (not . p)++spanEnd :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)+spanEnd p = breakEnd (not . p)++map :: (PrimType a, PrimType b) => (a -> b) -> UArray a -> UArray b+map f a = create lenB (\i -> f $ unsafeIndex a (offsetCast Proxy i))+  where !lenB = sizeCast (Proxy :: Proxy (a -> b)) (length a)++mapIndex :: (PrimType a, PrimType b) => (Offset b -> a -> b) -> UArray a -> UArray b+mapIndex f a = create (sizeCast Proxy $ length a) (\i -> f i $ unsafeIndex a (offsetCast Proxy i))++cons :: PrimType ty => ty -> UArray ty -> UArray ty+cons e vec+    | len == CountOf 0 = singleton e+    | otherwise     = runST $ do+        muv <- new (len + 1)+        unsafeCopyAtRO muv 1 vec 0 len+        unsafeWrite muv 0 e+        unsafeFreeze muv+  where+    !len = length vec++snoc :: PrimType ty => UArray ty -> ty -> UArray ty+snoc vec e+    | len == CountOf 0 = singleton e+    | otherwise     = runST $ do+        muv <- new (len + CountOf 1)+        unsafeCopyAtRO muv (Offset 0) vec (Offset 0) len+        unsafeWrite muv (0 `offsetPlusE` length vec) e+        unsafeFreeze muv+  where+     !len = length vec++uncons :: PrimType ty => UArray ty -> Maybe (ty, UArray ty)+uncons vec+    | nbElems == 0 = Nothing+    | otherwise    = Just (unsafeIndex vec 0, sub vec 1 (0 `offsetPlusE` nbElems))+  where+    !nbElems = length vec++unsnoc :: PrimType ty => UArray ty -> Maybe (UArray ty, ty)+unsnoc vec = case length vec - 1 of+    Nothing -> Nothing+    Just newLen -> Just (sub vec 0 lastElem, unsafeIndex vec lastElem)+                     where !lastElem = 0 `offsetPlusE` newLen++find :: PrimType ty => (ty -> Bool) -> UArray ty -> Maybe ty+find predicate vec = loop 0+  where+    !len = length vec+    loop i+        | i .==# len = Nothing+        | otherwise  =+            let e = unsafeIndex vec i+             in if predicate e then Just e else loop (i+1)++sortBy :: forall ty . PrimType ty => (ty -> ty -> Ordering) -> UArray ty -> UArray ty+sortBy ford vec = runST $ do+    mvec <- thaw vec+    onMutableBackend goNative (\fptr -> withFinalPtr fptr goAddr) mvec+    unsafeFreeze mvec+  where+    !len = length vec+    !start = offset vec++    goNative :: MutableBlock ty s -> ST s ()+    goNative mb = Alg.inplaceSortBy ford start len mb+    goAddr :: Ptr ty -> ST s ()+    goAddr (Ptr addr) = Alg.inplaceSortBy ford start len (Ptr addr :: Ptr ty)+{-# SPECIALIZE [3] sortBy :: (Word8 -> Word8 -> Ordering) -> UArray Word8 -> UArray Word8 #-}++filter :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> UArray ty+filter predicate arr = runST $ do+    (newLen, ma) <- newNative (length arr) $ \(MutableBlock mba) ->+            onBackendPrim (\block -> Alg.filter predicate mba block start end)+                          (\fptr -> withFinalPtr fptr $ \ptr@(Ptr !_) ->+                                        Alg.filter predicate mba ptr start end)+                          arr+    unsafeFreezeShrink ma newLen+  where+    !len   = length arr+    !start = offset arr+    !end   = start `offsetPlusE` len++reverse :: forall ty . PrimType ty => UArray ty -> UArray ty+reverse a+    | len == 0  = mempty+    | otherwise = runST $ do+        a <- newNative_ len $ \mba -> onBackendPrim (goNative mba)+                                                    (\fptr -> withFinalPtr fptr $ goAddr mba)+                                                    a+        unsafeFreeze a+  where+    !len = length a+    !end = 0 `offsetPlusE` len+    !start = offset a+    !endI = sizeAsOffset ((start + end) - Offset 1)++    goNative :: MutableBlock ty s -> Block ty -> ST s ()+    goNative !ma (Block !ba) = loop 0+      where+        loop !i+            | i == end  = pure ()+            | otherwise = BLK.unsafeWrite ma i (primBaIndex ba (sizeAsOffset (endI - i))) >> loop (i+1)+    goAddr :: MutableBlock ty s -> Ptr ty -> ST s ()+    goAddr !ma (Ptr addr) = loop 0+      where+        loop !i+            | i == end  = pure ()+            | otherwise = BLK.unsafeWrite ma i (primAddrIndex addr (sizeAsOffset (endI - i))) >> loop (i+1)+{-# SPECIALIZE [3] reverse :: UArray Word8 -> UArray Word8 #-}+{-# SPECIALIZE [3] reverse :: UArray Word32 -> UArray Word32 #-}+{-# SPECIALIZE [3] reverse :: UArray Char -> UArray Char #-}++-- Finds where are the insertion points when we search for a `needle`+-- within an `haystack`.+-- Throws an error in case `needle` is empty.+indices :: PrimType ty => UArray ty -> UArray ty -> [Offset ty]+indices needle hy+  | needleLen <= 0 = error "Basement.UArray.indices: needle is empty."+  | otherwise = case haystackLen < needleLen of+                  True  -> []+                  False -> go (Offset 0) []+  where+    !haystackLen = length hy++    !needleLen = length needle++    go currentOffset ipoints+      | (currentOffset `offsetPlusE` needleLen) > (sizeAsOffset haystackLen) = ipoints+      | otherwise =+        let matcher = take needleLen . drop (offsetAsSize currentOffset) $ hy+        in case matcher == needle of+             -- TODO: Move away from right-appending as it's gonna be slow.+             True  -> go (currentOffset `offsetPlusE` needleLen) (ipoints <> [currentOffset])+             False -> go (currentOffset + 1) ipoints++-- | Replace all the occurrencies of `needle` with `replacement` in+-- the `haystack` string.+replace :: PrimType ty => UArray ty -> UArray ty -> UArray ty -> UArray ty+replace (needle :: UArray ty) replacement haystack = runST $ do+    case null needle of+      True -> error "Basement.UArray.replace: empty needle"+      False -> do+        let insertionPoints = indices needle haystack+        let !(CountOf occs) = List.length insertionPoints+        let !newLen         = haystackLen `sizeSub` (multBy needleLen occs) + (multBy replacementLen occs)+        ms <- new newLen+        loop ms (Offset 0) (Offset 0) insertionPoints+  where++    multBy (CountOf x) y = CountOf (x * y)++    !needleLen = length needle++    !replacementLen = length replacement++    !haystackLen = length haystack++    -- Go through each insertion point and copy things over.+    -- We keep around the offset to the original string to+    -- be able to copy bytes which didn't change.+    loop :: PrimMonad prim+         => MUArray ty (PrimState prim)+         -> Offset ty+         -> Offset ty+         -> [Offset ty]+         -> prim (UArray ty)+    loop mba currentOffset offsetInOriginalString [] = do+      -- Finalise the string+      let !unchangedDataLen = sizeAsOffset haystackLen - offsetInOriginalString+      unsafeCopyAtRO mba currentOffset haystack offsetInOriginalString unchangedDataLen+      freeze mba+    loop mba currentOffset offsetInOriginalString (x:xs) = do+        -- 1. Copy from the old string.+        let !unchangedDataLen = (x - offsetInOriginalString)+        unsafeCopyAtRO mba currentOffset haystack offsetInOriginalString unchangedDataLen+        let !newOffset = currentOffset `offsetPlusE` unchangedDataLen+        -- 2. Copy the replacement.+        unsafeCopyAtRO mba newOffset replacement (Offset 0) replacementLen+        let !offsetInOriginalString' = offsetInOriginalString `offsetPlusE` unchangedDataLen `offsetPlusE` needleLen+        loop mba (newOffset `offsetPlusE` replacementLen) offsetInOriginalString' xs+{-# SPECIALIZE [3] replace :: UArray Word8 -> UArray Word8 -> UArray Word8 -> UArray Word8 #-}++foldr :: PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a+foldr f initialAcc vec = loop 0+  where+    !len = length vec+    loop i+        | i .==# len = initialAcc+        | otherwise  = unsafeIndex vec i `f` loop (i+1)++foldl' :: PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a+foldl' f initialAcc arr = onBackendPure' arr (Alg.foldl f initialAcc)+{-# SPECIALIZE [3] foldl' :: (a -> Word8 -> a) -> a -> UArray Word8 -> a #-}++foldl1' :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty+foldl1' f (NonEmpty arr) = onBackendPure' arr (Alg.foldl1 f)+{-# SPECIALIZE [3] foldl1' :: (Word8 -> Word8 -> Word8) -> NonEmpty (UArray Word8) -> Word8 #-}++foldr1 :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty+foldr1 f arr = let (initialAcc, rest) = revSplitAt 1 $ getNonEmpty arr+               in foldr f (unsafeIndex initialAcc 0) rest++all :: PrimType ty => (ty -> Bool) -> UArray ty -> Bool+all predicate arr = onBackendPure' arr $ Alg.all predicate+{-# SPECIALIZE [3] all :: (Word8 -> Bool) -> UArray Word8 -> Bool #-}++any :: PrimType ty => (ty -> Bool) -> UArray ty -> Bool+any predicate arr = onBackendPure' arr $ Alg.any predicate+{-# SPECIALIZE [3] any :: (Word8 -> Bool) -> UArray Word8 -> Bool #-}++builderAppend :: (PrimType ty, PrimMonad state) => ty -> Builder (UArray ty) (MUArray ty) ty state err ()+builderAppend v = Builder $ State $ \(i, st, e) ->+    if offsetAsSize i == chunkSize st+        then do+            cur      <- unsafeFreeze (curChunk st)+            newChunk <- new (chunkSize st)+            unsafeWrite newChunk 0 v+            pure ((), (Offset 1, st { prevChunks     = cur : prevChunks st+                                    , prevChunksSize = chunkSize st + prevChunksSize st+                                    , curChunk       = newChunk+                                    }, e))+        else do+            unsafeWrite (curChunk st) i v+            pure ((), (i + 1, st, e))++builderBuild :: (PrimType ty, PrimMonad m) => Int -> Builder (UArray ty) (MUArray ty) ty m err () -> m (Either err (UArray ty))+builderBuild sizeChunksI ab+    | sizeChunksI <= 0 = builderBuild 64 ab+    | otherwise        = do+        first      <- new sizeChunks+        (i, st, e) <- snd <$> runState (runBuilder ab) (Offset 0, BuildingState [] (CountOf 0) first sizeChunks, Nothing)+        case e of+          Just err -> pure (Left err)+          Nothing -> do+            cur <- unsafeFreezeShrink (curChunk st) (offsetAsSize i)+            -- Build final array+            let totalSize = prevChunksSize st + offsetAsSize i+            bytes <- new totalSize >>= fillFromEnd totalSize (cur : prevChunks st) >>= unsafeFreeze+            pure (Right bytes)+  where+      sizeChunks = CountOf sizeChunksI++      fillFromEnd _    []     mua = pure mua+      fillFromEnd !end (x:xs) mua = do+          let sz = length x+          let start = end `sizeSub` sz+          unsafeCopyAtRO mua (sizeAsOffset start) x (Offset 0) sz+          fillFromEnd start xs mua++builderBuild_ :: (PrimType ty, PrimMonad m) => Int -> Builder (UArray ty) (MUArray ty) ty m () () -> m (UArray ty)+builderBuild_ sizeChunksI ab = either (\() -> internalError "impossible output") id <$> builderBuild sizeChunksI ab++toHexadecimal :: PrimType ty => UArray ty -> UArray Word8+toHexadecimal ba+    | len == CountOf 0 = mempty+    | otherwise     = runST $ do+        ma <- new (len `scale` 2)+        unsafeIndexer b8 (go ma)+        unsafeFreeze ma+  where+    b8 = unsafeRecast ba+    !len = length b8+    !endOfs = Offset 0 `offsetPlusE` len++    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()+    go !ma !getAt = loop 0 0+      where+        loop !dIdx !sIdx+            | sIdx == endOfs = pure ()+            | otherwise      = do+                let !(W8# !w)       = getAt sIdx+                    !(# wHi, wLo #) = Base16.unsafeConvertByte (word8ToWordCompat# w)+                unsafeWrite ma dIdx     (W8# (wordToWord8Compat# wHi))+                unsafeWrite ma (dIdx+1) (W8# (wordToWord8Compat# wLo))+                loop (dIdx + 2) (sIdx+1)++toBase64Internal :: PrimType ty => Addr# -> UArray ty -> Bool -> UArray Word8+toBase64Internal table src padded+    | len == CountOf 0 = mempty+    | otherwise = runST $ do+        ma <- new dstLen+        unsafeIndexer b8 (go ma)+        unsafeFreeze ma+  where+    b8 = unsafeRecast src+    !len = length b8+    !dstLen = outputLengthBase64 padded len+    !endOfs = Offset 0 `offsetPlusE` len+    !dstEndOfs = Offset 0 `offsetPlusE` dstLen++    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()+    go !ma !getAt = loop 0 0+      where+        eqChar = 0x3d :: Word8++        loop !sIdx !dIdx+            | sIdx == endOfs = when padded $ do+                when (dIdx `offsetPlusE` CountOf 1 <= dstEndOfs) $ unsafeWrite ma dIdx eqChar+                when (dIdx `offsetPlusE` CountOf 2 == dstEndOfs) $ unsafeWrite ma (dIdx `offsetPlusE` CountOf 1) eqChar+            | otherwise = do+                let !b2Idx = sIdx `offsetPlusE` CountOf 1+                    !b3Idx = sIdx `offsetPlusE` CountOf 2++                    !b2Available = b2Idx < endOfs+                    !b3Available = b3Idx < endOfs++                    !b1 = getAt sIdx+                    !b2 = if b2Available then getAt b2Idx else 0+                    !b3 = if b3Available then getAt b3Idx else 0++                    (w,x,y,z) = convert3 table b1 b2 b3++                    sNextIncr = 1 + fromEnum b2Available + fromEnum b3Available+                    dNextIncr = 1 + sNextIncr++                unsafeWrite ma dIdx w+                unsafeWrite ma (dIdx `offsetPlusE` CountOf 1) x++                when b2Available $ unsafeWrite ma (dIdx `offsetPlusE` CountOf 2) y+                when b3Available $ unsafeWrite ma (dIdx `offsetPlusE` CountOf 3) z++                loop (sIdx `offsetPlusE` CountOf sNextIncr) (dIdx `offsetPlusE` CountOf dNextIncr)++outputLengthBase64 :: Bool -> CountOf Word8 -> CountOf Word8+outputLengthBase64 padding (CountOf inputLenInt) = outputLength+  where+    outputLength = if padding then CountOf lenWithPadding else CountOf lenWithoutPadding+    lenWithPadding+        | m == 0    = 4 * d+        | otherwise = 4 * (d + 1)+    lenWithoutPadding+        | m == 0    = 4 * d+        | otherwise = 4 * d + m + 1+    (d,m) = inputLenInt `divMod` 3++convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)+convert3 table (W8# a) (W8# b) (W8# c) =+    let !w = narrow8Word# (uncheckedShiftRL# (word8ToWordCompat# a) 2#)+        !x = or# (and# (uncheckedShiftL# (word8ToWordCompat# a) 4#) 0x30##) (uncheckedShiftRL# (word8ToWordCompat# b) 4#)+        !y = or# (and# (uncheckedShiftL# (word8ToWordCompat# b) 2#) 0x3c##) (uncheckedShiftRL# (word8ToWordCompat# c) 6#)+        !z = and# (word8ToWordCompat# c) 0x3f##+     in (idx w, idx x, idx y, idx z)+  where+    idx :: Word# -> Word8+    idx i = W8# (indexWord8OffAddr# table (word2Int# i))++isPrefixOf :: PrimType ty => UArray ty -> UArray ty -> Bool+isPrefixOf pre arr+    | pLen > pArr = False+    | otherwise   = pre == unsafeTake pLen arr+  where+    !pLen = length pre+    !pArr = length arr+{-# SPECIALIZE [3] isPrefixOf :: UArray Word8 -> UArray Word8 -> Bool #-}++isSuffixOf :: PrimType ty => UArray ty -> UArray ty -> Bool+isSuffixOf suffix arr+    | pLen > pArr = False+    | otherwise   = suffix == revTake pLen arr+  where+    !pLen = length suffix+    !pArr = length arr+{-# SPECIALIZE [3] isSuffixOf :: UArray Word8 -> UArray Word8 -> Bool #-}
+ Basement/UArray/Base.hs view
@@ -0,0 +1,651 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Basement.UArray.Base+    ( MUArray(..)+    , UArray(..)+    , MUArrayBackend(..)+    , UArrayBackend(..)+    -- * New mutable array creation+    , newUnpinned+    , newPinned+    , newNative+    , newNative_+    , new+    -- * Pinning status+    , isPinned+    , isMutablePinned+    -- * Mutable array accessor+    , unsafeRead+    , unsafeWrite+    -- * Freezing routines+    , unsafeFreezeShrink+    , unsafeFreeze+    , unsafeThaw+    , thaw+    , copy+    -- * Array accessor+    , unsafeIndex+    , unsafeIndexer+    , onBackend+    , onBackendPure+    , onBackendPure'+    , onBackendPrim+    , onMutableBackend+    , unsafeDewrap+    , unsafeDewrap2+    -- * Basic lowlevel functions+    , vFromListN+    , empty+    , length+    , offset+    , ValidRange(..)+    , offsetsValidRange+    , equal+    , equalMemcmp+    , compare+    , copyAt+    , unsafeCopyAtRO+    , toBlock+    -- * temporary+    , pureST+    ) where++import           GHC.Exts+import           GHC.Types+import           GHC.Ptr+import           GHC.ST+import           Basement.Compat.Primitive+import           Basement.Monad+import           Basement.PrimType+import           Basement.Compat.Base+import           Basement.Compat.C.Types+import           Basement.Compat.Semigroup+import qualified Basement.Runtime as Runtime+import           Data.Proxy+import qualified Basement.Compat.ExtList as List+import qualified Basement.Alg.Class as Alg+import           Basement.Types.OffsetSize+import           Basement.FinalPtr+import           Basement.NormalForm+import           Basement.Block (MutableBlock(..), Block(..))+import qualified Basement.Block as BLK+import qualified Basement.Block.Mutable as MBLK+import           Basement.Numerical.Additive+import           Basement.Bindings.Memory+import           System.IO.Unsafe (unsafeDupablePerformIO)++-- | A Mutable array of types built on top of GHC primitive.+--+-- Element in this array can be modified in place.+data MUArray ty st = MUArray {-# UNPACK #-} !(Offset ty)+                             {-# UNPACK #-} !(CountOf ty)+                                            !(MUArrayBackend ty st)++data MUArrayBackend ty st = MUArrayMBA (MutableBlock ty st) | MUArrayAddr (FinalPtr ty)+++instance PrimType ty => Alg.Indexable (Ptr ty) ty where+    index (Ptr addr) = primAddrIndex addr++instance Alg.Indexable (Ptr Word8) Word64 where+    index (Ptr addr) = primAddrIndex addr++instance (PrimMonad prim, PrimType ty) => Alg.RandomAccess (Ptr ty) prim ty where+    read (Ptr addr) = primAddrRead addr+    write (Ptr addr) = primAddrWrite addr++-- | An array of type built on top of GHC primitive.+--+-- The elements need to have fixed sized and the representation is a+-- packed contiguous array in memory that can easily be passed+-- to foreign interface+data UArray ty = UArray {-# UNPACK #-} !(Offset ty)+                        {-# UNPACK #-} !(CountOf ty)+                                       !(UArrayBackend ty)+    deriving (Typeable)++data UArrayBackend ty = UArrayBA !(Block ty) | UArrayAddr !(FinalPtr ty)+    deriving (Typeable)++instance Data ty => Data (UArray ty) where+    dataTypeOf _ = arrayType+    toConstr _   = error "toConstr"+    gunfold _ _  = error "gunfold"++arrayType :: DataType+arrayType = mkNoRepType "Basement.UArray"++instance NormalForm (UArray ty) where+    toNormalForm (UArray _ _ !_) = ()+instance (PrimType ty, Show ty) => Show (UArray ty) where+    show v = show (toList v)+instance (PrimType ty, Eq ty) => Eq (UArray ty) where+    (==) = equal+instance (PrimType ty, Ord ty) => Ord (UArray ty) where+    {-# SPECIALIZE instance Ord (UArray Word8) #-}+    compare = vCompare++instance PrimType ty => Semigroup (UArray ty) where+    (<>) = append+instance PrimType ty => Monoid (UArray ty) where+    mempty  = empty+    mappend = append+    mconcat = concat++instance PrimType ty => IsList (UArray ty) where+    type Item (UArray ty) = ty+    fromList = vFromList+    fromListN len = vFromListN (CountOf len)+    toList = vToList++length :: UArray ty -> CountOf ty+length (UArray _ len _) = len+{-# INLINE[1] length #-}++offset :: UArray ty -> Offset ty+offset (UArray ofs _ _) = ofs+{-# INLINE[1] offset #-}++data ValidRange ty = ValidRange {-# UNPACK #-} !(Offset ty) {-# UNPACK #-} !(Offset ty)++offsetsValidRange :: UArray ty -> ValidRange ty+offsetsValidRange (UArray ofs len _) = ValidRange ofs (ofs `offsetPlusE` len)++-- | Return if the array is pinned in memory+--+-- note that Foreign array are considered pinned+isPinned :: UArray ty -> PinnedStatus+isPinned (UArray _ _ (UArrayAddr {})) = Pinned+isPinned (UArray _ _ (UArrayBA blk))  = BLK.isPinned blk++-- | Return if a mutable array is pinned in memory+isMutablePinned :: MUArray ty st -> PinnedStatus+isMutablePinned (MUArray _ _ (MUArrayAddr {})) = Pinned+isMutablePinned (MUArray _ _ (MUArrayMBA mb))  = BLK.isMutablePinned mb++-- | Create a new pinned mutable array of size @n.+--+-- all the cells are uninitialized and could contains invalid values.+--+-- All mutable arrays are allocated on a 64 bits aligned addresses+newPinned :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MUArray ty (PrimState prim))+newPinned n = MUArray 0 n . MUArrayMBA <$> MBLK.newPinned n++-- | Create a new unpinned mutable array of size @n elements.+--+-- If the size exceeds a GHC-defined threshold, then the memory will be+-- pinned. To be certain about pinning status with small size, use 'newPinned'+newUnpinned :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MUArray ty (PrimState prim))+newUnpinned n = MUArray 0 n . MUArrayMBA <$> MBLK.new n++newNative :: (PrimMonad prim, PrimType ty)+          => CountOf ty+          -> (MutableBlock ty (PrimState prim) -> prim a)+          -> prim (a, MUArray ty (PrimState prim))+newNative n f = do+    mb <- MBLK.new n+    a  <- f mb+    pure (a, MUArray 0 n (MUArrayMBA mb))++-- | Same as newNative but expect no extra return value from f+newNative_ :: (PrimMonad prim, PrimType ty)+           => CountOf ty+           -> (MutableBlock ty (PrimState prim) -> prim ())+           -> prim (MUArray ty (PrimState prim))+newNative_ n f = do+    mb <- MBLK.new n+    f mb+    pure (MUArray 0 n (MUArrayMBA mb))++-- | Create a new mutable array of size @n.+--+-- When memory for a new array is allocated, we decide if that memory region+-- should be pinned (will not be copied around by GC) or unpinned (can be+-- moved around by GC) depending on its size.+--+-- You can change the threshold value used by setting the environment variable+-- @HS_FOUNDATION_UARRAY_UNPINNED_MAX@.+new :: (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MUArray ty (PrimState prim))+new sz+    | sizeRecast sz <= maxSizeUnpinned = newUnpinned sz+    | otherwise                        = newPinned sz+  where+    -- Safe to use here: If the value changes during runtime, this will only+    -- have an impact on newly created arrays.+    maxSizeUnpinned = Runtime.unsafeUArrayUnpinnedMaxSize+{-# INLINE new #-}++-- | read from a cell in a mutable array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'read' if unsure.+unsafeRead :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Offset ty -> prim ty+unsafeRead (MUArray start _ (MUArrayMBA (MutableBlock mba))) i = primMbaRead mba (start + i)+unsafeRead (MUArray start _ (MUArrayAddr fptr)) i = withFinalPtr fptr $ \(Ptr addr) -> primAddrRead addr (start + i)+{-# INLINE unsafeRead #-}+++-- | write to a cell in a mutable array without bounds checking.+--+-- Writing with invalid bounds will corrupt memory and your program will+-- become unreliable. use 'write' if unsure.+unsafeWrite :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()+unsafeWrite (MUArray start _ (MUArrayMBA mb)) i v = MBLK.unsafeWrite mb (start+i) v+unsafeWrite (MUArray start _ (MUArrayAddr fptr)) i v = withFinalPtr fptr $ \(Ptr addr) -> primAddrWrite addr (start+i) v+{-# INLINE unsafeWrite #-}++-- | Return the element at a specific index from an array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'index' if unsure.+unsafeIndex :: forall ty . PrimType ty => UArray ty -> Offset ty -> ty+unsafeIndex (UArray start _ (UArrayBA ba)) n = BLK.unsafeIndex ba (start + n)+unsafeIndex (UArray start _ (UArrayAddr fptr)) n = withUnsafeFinalPtr fptr (\(Ptr addr) -> return (primAddrIndex addr (start+n)) :: IO ty)+{-# INLINE unsafeIndex #-}++unsafeIndexer :: (PrimMonad prim, PrimType ty) => UArray ty -> ((Offset ty -> ty) -> prim a) -> prim a+unsafeIndexer (UArray start _ (UArrayBA ba)) f = f (\n -> BLK.unsafeIndex ba (start + n))+unsafeIndexer (UArray start _ (UArrayAddr fptr)) f = withFinalPtr fptr $ \(Ptr addr) -> f (\n -> primAddrIndex addr (start + n))+{-# INLINE unsafeIndexer #-}++-- | Freeze a mutable array into an array.+--+-- the MUArray must not be changed after freezing.+unsafeFreeze :: PrimMonad prim => MUArray ty (PrimState prim) -> prim (UArray ty)+unsafeFreeze (MUArray start len (MUArrayMBA mba)) =+    UArray start len . UArrayBA <$> MBLK.unsafeFreeze mba+unsafeFreeze (MUArray start len (MUArrayAddr fptr)) =+    pure $ UArray start len (UArrayAddr fptr)+{-# INLINE unsafeFreeze #-}++unsafeFreezeShrink :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)+unsafeFreezeShrink (MUArray start _ backend) n = unsafeFreeze (MUArray start n backend)+{-# INLINE unsafeFreezeShrink #-}++-- | Thaw an immutable array.+--+-- The UArray must not be used after thawing.+unsafeThaw :: (PrimType ty, PrimMonad prim) => UArray ty -> prim (MUArray ty (PrimState prim))+unsafeThaw (UArray start len (UArrayBA blk)) = MUArray start len . MUArrayMBA <$> BLK.unsafeThaw blk+unsafeThaw (UArray start len (UArrayAddr fptr)) = pure $ MUArray start len (MUArrayAddr fptr)+{-# INLINE unsafeThaw #-}++-- | Thaw an array to a mutable array.+--+-- the array is not modified, instead a new mutable array is created+-- and every values is copied, before returning the mutable array.+thaw :: (PrimMonad prim, PrimType ty) => UArray ty -> prim (MUArray ty (PrimState prim))+thaw array = do+    ma <- new (length array)+    unsafeCopyAtRO ma azero array (Offset 0) (length array)+    pure ma+{-# INLINE thaw #-}++-- | Copy every cells of an existing array to a new array+copy :: PrimType ty => UArray ty -> UArray ty+copy array = runST (thaw array >>= unsafeFreeze)+++onBackend :: (Block ty -> a)+          -> (FinalPtr ty -> Ptr ty -> ST s a)+          -> UArray ty+          -> a+onBackend onBa _      (UArray _ _ (UArrayBA ba))     = onBa ba+onBackend _    onAddr (UArray _ _ (UArrayAddr fptr)) = withUnsafeFinalPtr fptr $ \ptr@(Ptr !_) -> +                                                           onAddr fptr ptr+{-# INLINE onBackend #-}++onBackendPure :: (Block ty -> a)+              -> (Ptr ty -> a)+              -> UArray ty+              -> a+onBackendPure goBA goAddr arr = onBackend goBA (\_ -> pureST . goAddr) arr+{-# INLINE onBackendPure #-}++onBackendPure' :: forall ty a . PrimType  ty+               => UArray ty+               -> (forall container. Alg.Indexable container ty +                   => container -> Offset ty -> Offset ty -> a)+               -> a+onBackendPure' arr f = onBackendPure f' f' arr+  where f' :: Alg.Indexable container ty => container -> a+        f' c = f c start end+          where (ValidRange !start !end) = offsetsValidRange arr+{-# INLINE onBackendPure' #-}++onBackendPrim :: PrimMonad prim+              => (Block ty -> prim a)+              -> (FinalPtr ty -> prim a)+              -> UArray ty+              -> prim a+onBackendPrim onBa _      (UArray _ _ (UArrayBA ba))     = onBa ba+onBackendPrim _    onAddr (UArray _ _ (UArrayAddr fptr)) = onAddr fptr+{-# INLINE onBackendPrim #-}++onMutableBackend :: PrimMonad prim+                 => (MutableBlock ty (PrimState prim) -> prim a)+                 -> (FinalPtr ty -> prim a)+                 -> MUArray ty (PrimState prim)+                 -> prim a+onMutableBackend onMba _      (MUArray _ _ (MUArrayMBA mba))   = onMba mba+onMutableBackend _     onAddr (MUArray _ _ (MUArrayAddr fptr)) = onAddr fptr+{-# INLINE onMutableBackend #-}+++unsafeDewrap :: (Block ty -> Offset ty -> a)+             -> (Ptr ty -> Offset ty -> ST s a)+             -> UArray ty+             -> a+unsafeDewrap _ g (UArray start _ (UArrayAddr fptr))     = withUnsafeFinalPtr fptr $ \ptr -> g ptr start+unsafeDewrap f _ (UArray start _ (UArrayBA ba)) = f ba start+{-# INLINE unsafeDewrap #-}++unsafeDewrap2 :: (ByteArray# -> ByteArray# -> a)+              -> (Ptr ty -> Ptr ty -> ST s a)+              -> (ByteArray# -> Ptr ty -> ST s a)+              -> (Ptr ty -> ByteArray# -> ST s a)+              -> UArray ty+              -> UArray ty+              -> a+unsafeDewrap2 f g h i (UArray _ _ back1) (UArray _ _ back2) =+    case (back1, back2) of+        (UArrayBA (Block ba1), UArrayBA (Block ba2)) -> f ba1 ba2+        (UArrayAddr fptr1, UArrayAddr fptr2)         -> withUnsafeFinalPtr fptr1 $ \ptr1 -> withFinalPtr fptr2 $ \ptr2 -> g ptr1 ptr2+        (UArrayBA (Block ba1), UArrayAddr fptr2)     -> withUnsafeFinalPtr fptr2 $ \ptr2 -> h ba1 ptr2+        (UArrayAddr fptr1, UArrayBA (Block ba2))     -> withUnsafeFinalPtr fptr1 $ \ptr1 -> i ptr1 ba2+{-# INLINE [2] unsafeDewrap2 #-}++pureST :: a -> ST s a+pureST = pure++-- | make an array from a list of elements.+vFromList :: forall ty . PrimType ty => [ty] -> UArray ty+vFromList l = runST $ do+    a <- newNative_ len copyList+    unsafeFreeze a+  where+    len = List.length l+    copyList :: MutableBlock ty s -> ST s ()+    copyList mb = loop 0 l+      where+        loop _  []     = pure ()+        loop !i (x:xs) = MBLK.unsafeWrite mb i x >> loop (i+1) xs++-- | Make an array from a list of elements with a size hint.+--+-- The list should be of the same size as the hint, as otherwise:+--+-- * The length of the list is smaller than the hint:+--    the array allocated is of the size of the hint, but is sliced+--    to only represent the valid bits+-- * The length of the list is bigger than the hint:+--    The allocated array is the size of the hint, and the list is truncated to+--    fit.+vFromListN :: forall ty . PrimType ty => CountOf ty -> [ty] -> UArray ty+vFromListN len l = runST $ do+    (sz, ma) <- newNative len copyList+    unsafeFreezeShrink ma sz+  where+    copyList :: MutableBlock ty s -> ST s (CountOf ty)+    copyList mb = loop 0 l+      where+        loop !i  []     = pure (offsetAsSize i)+        loop !i (x:xs)+            | i .==# len = pure (offsetAsSize i)+            | otherwise  = MBLK.unsafeWrite mb i x >> loop (i+1) xs++-- | transform an array to a list.+vToList :: forall ty . PrimType ty => UArray ty -> [ty]+vToList a+    | len == 0  = []+    | otherwise = unsafeDewrap goBa goPtr a+  where+    !len = length a+    goBa (Block ba) start = loop start+      where+        !end = start `offsetPlusE` len+        loop !i | i == end  = []+                | otherwise = primBaIndex ba i : loop (i+1)+    goPtr (Ptr addr) start = pureST (loop start)+      where+        !end = start `offsetPlusE` len+        loop !i | i == end  = []+                | otherwise = primAddrIndex addr i : loop (i+1)++-- | Check if two vectors are identical+equal :: (PrimType ty, Eq ty) => UArray ty -> UArray ty -> Bool+equal a b+    | la /= lb  = False+    | otherwise = unsafeDewrap2 goBaBa goPtrPtr goBaPtr goPtrBa a b+  where+    !start1 = offset a+    !start2 = offset b+    !end = start1 `offsetPlusE` la+    !la = length a+    !lb = length b+    goBaBa ba1 ba2 = loop start1 start2+      where+        loop !i !o | i == end  = True+                   | otherwise = primBaIndex ba1 i == primBaIndex ba2 o && loop (i+o1) (o+o1)+    goPtrPtr (Ptr addr1) (Ptr addr2) = pureST (loop start1 start2)+      where+        loop !i !o | i == end  = True+                   | otherwise = primAddrIndex addr1 i == primAddrIndex addr2 o && loop (i+o1) (o+o1)+    goBaPtr ba1 (Ptr addr2) = pureST (loop start1 start2)+      where+        loop !i !o | i == end  = True+                   | otherwise = primBaIndex ba1 i == primAddrIndex addr2 o && loop (i+o1) (o+o1)+    goPtrBa (Ptr addr1) ba2 = pureST (loop start1 start2)+      where+        loop !i !o | i == end  = True+                   | otherwise = primAddrIndex addr1 i == primBaIndex ba2 o && loop (i+o1) (o+o1)++    o1 = Offset (I# 1#)+{-# RULES "UArray/Eq/Word8" [3] equal = equalBytes #-}+{-# INLINEABLE [2] equal #-}++equalBytes :: UArray Word8 -> UArray Word8 -> Bool+equalBytes a b+    | la /= lb  = False+    | otherwise = memcmp a b (sizeInBytes la) == 0+  where+    !la = length a+    !lb = length b++equalMemcmp :: PrimType ty => UArray ty -> UArray ty -> Bool+equalMemcmp a b+    | la /= lb  = False+    | otherwise = memcmp a b (sizeInBytes la) == 0+  where+    !la = length a+    !lb = length b++-- | Compare 2 vectors+vCompare :: (Ord ty, PrimType ty) => UArray ty -> UArray ty -> Ordering+vCompare a@(UArray start1 la _) b@(UArray start2 lb _) = unsafeDewrap2 goBaBa goPtrPtr goBaPtr goPtrBa a b+  where+    !end = start1 `offsetPlusE` min la lb+    o1 = Offset (I# 1#)+    goBaBa ba1 ba2 = loop start1 start2+      where+        loop !i !o | i == end   = la `compare` lb+                   | v1 == v2   = loop (i + o1) (o + o1)+                   | otherwise  = v1 `compare` v2+          where v1 = primBaIndex ba1 i+                v2 = primBaIndex ba2 o+    goPtrPtr (Ptr addr1) (Ptr addr2) = pureST (loop start1 start2)+      where+        loop !i !o | i == end   = la `compare` lb+                   | v1 == v2   = loop (i + o1) (o + o1)+                   | otherwise  = v1 `compare` v2+          where v1 = primAddrIndex addr1 i+                v2 = primAddrIndex addr2 o+    goBaPtr ba1 (Ptr addr2) = pureST (loop start1 start2)+      where+        loop !i !o | i == end   = la `compare` lb+                   | v1 == v2   = loop (i + o1) (o + o1)+                   | otherwise  = v1 `compare` v2+          where v1 = primBaIndex ba1 i+                v2 = primAddrIndex addr2 o+    goPtrBa (Ptr addr1) ba2 = pureST (loop start1 start2)+      where+        loop !i !o | i == end   = la `compare` lb+                   | v1 == v2   = loop (i + o1) (o + o1)+                   | otherwise  = v1 `compare` v2+          where v1 = primAddrIndex addr1 i+                v2 = primBaIndex ba2 o+-- {-# SPECIALIZE [3] vCompare :: UArray Word8 -> UArray Word8 -> Ordering = vCompareBytes #-}+{-# RULES "UArray/Ord/Word8" [3] vCompare = vCompareBytes #-}+{-# INLINEABLE [2] vCompare #-}++vCompareBytes :: UArray Word8 -> UArray Word8 -> Ordering+vCompareBytes = vCompareMemcmp++vCompareMemcmp :: (Ord ty, PrimType ty) => UArray ty -> UArray ty -> Ordering+vCompareMemcmp a b = cintToOrdering $ memcmp a b sz+  where+    la = length a+    lb = length b+    sz = sizeInBytes $ min la lb+    cintToOrdering :: CInt -> Ordering+    cintToOrdering 0 = la `compare` lb+    cintToOrdering r | r < 0     = LT+                     | otherwise = GT+{-# SPECIALIZE [3] vCompareMemcmp :: UArray Word8 -> UArray Word8 -> Ordering #-}++memcmp :: PrimType ty => UArray ty -> UArray ty -> CountOf Word8 -> CInt+memcmp a@(UArray (offsetInBytes -> o1) _ _) b@(UArray (offsetInBytes -> o2) _ _) sz = unsafeDewrap2+    (\s1 s2 -> unsafeDupablePerformIO $ sysHsMemcmpBaBa s1 o1 s2 o2 sz)+    (\s1 s2 -> unsafePrimToST $ sysHsMemcmpPtrPtr s1 o1 s2 o2 sz)+    (\s1 s2 -> unsafePrimToST $ sysHsMemcmpBaPtr s1 o1 s2 o2 sz)+    (\s1 s2 -> unsafePrimToST $ sysHsMemcmpPtrBa s1 o1 s2 o2 sz)+    a b+{-# SPECIALIZE [3] memcmp :: UArray Word8 -> UArray Word8 -> CountOf Word8 -> CInt #-}++-- | Copy a number of elements from an array to another array with offsets+copyAt :: forall prim ty . (PrimMonad prim, PrimType ty)+       => MUArray ty (PrimState prim) -- ^ destination array+       -> Offset ty                  -- ^ offset at destination+       -> MUArray ty (PrimState prim) -- ^ source array+       -> Offset ty                  -- ^ offset at source+       -> CountOf ty                    -- ^ number of elements to copy+       -> prim ()+copyAt (MUArray dstStart _ (MUArrayMBA (MutableBlock dstMba))) ed (MUArray srcStart _ (MUArrayMBA (MutableBlock srcBa))) es n =+    primitive $ \st -> (# copyMutableByteArray# srcBa os dstMba od nBytes st, () #)+  where+    !sz                 = primSizeInBytes (Proxy :: Proxy ty)+    !(Offset (I# os))   = offsetOfE sz (srcStart + es)+    !(Offset (I# od))   = offsetOfE sz (dstStart + ed)+    !(CountOf (I# nBytes)) = sizeOfE sz n+copyAt (MUArray dstStart _ (MUArrayMBA (MutableBlock dstMba))) ed (MUArray srcStart _ (MUArrayAddr srcFptr)) es n =+    withFinalPtr srcFptr $ \srcPtr ->+        let !(Ptr srcAddr) = srcPtr `plusPtr` os+         in primitive $ \s -> (# copyAddrToByteArray# srcAddr dstMba od nBytes s, () #)+  where+    !sz                 = primSizeInBytes (Proxy :: Proxy ty)+    !(Offset os)        = offsetOfE sz (srcStart + es)+    !(Offset (I# od))   = offsetOfE sz (dstStart + ed)+    !(CountOf (I# nBytes)) = sizeOfE sz n+copyAt dst od src os n = loop od os+  where+    !endIndex = os `offsetPlusE` n+    loop !d !i+        | i == endIndex = return ()+        | otherwise     = unsafeRead src i >>= unsafeWrite dst d >> loop (d+1) (i+1)++-- TODO Optimise with copyByteArray#+-- | Copy @n@ sequential elements from the specified offset in a source array+--   to the specified position in a destination array.+--+--   This function does not check bounds. Accessing invalid memory can return+--   unpredictable and invalid values.+unsafeCopyAtRO :: forall prim ty . (PrimMonad prim, PrimType ty)+               => MUArray ty (PrimState prim) -- ^ destination array+               -> Offset ty                   -- ^ offset at destination+               -> UArray ty                   -- ^ source array+               -> Offset ty                   -- ^ offset at source+               -> CountOf ty                     -- ^ number of elements to copy+               -> prim ()+unsafeCopyAtRO (MUArray dstStart _ (MUArrayMBA (MutableBlock dstMba))) ed (UArray srcStart _ (UArrayBA (Block srcBa))) es n =+    primitive $ \st -> (# copyByteArray# srcBa os dstMba od nBytes st, () #)+  where+    sz = primSizeInBytes (Proxy :: Proxy ty)+    !(Offset (I# os))   = offsetOfE sz (srcStart+es)+    !(Offset (I# od))   = offsetOfE sz (dstStart+ed)+    !(CountOf (I# nBytes)) = sizeOfE sz n+unsafeCopyAtRO (MUArray dstStart _ (MUArrayMBA (MutableBlock dstMba))) ed (UArray srcStart _ (UArrayAddr srcFptr)) es n =+    withFinalPtr srcFptr $ \srcPtr ->+        let !(Ptr srcAddr) = srcPtr `plusPtr` os+         in primitive $ \s -> (# copyAddrToByteArray# srcAddr dstMba od nBytes s, () #)+  where+    sz  = primSizeInBytes (Proxy :: Proxy ty)+    !(Offset os)        = offsetOfE sz (srcStart+es)+    !(Offset (I# od))   = offsetOfE sz (dstStart+ed)+    !(CountOf (I# nBytes)) = sizeOfE sz n+unsafeCopyAtRO dst od src os n = loop od os+  where+    !endIndex = os `offsetPlusE` n+    loop d i+        | i == endIndex = return ()+        | otherwise     = unsafeWrite dst d (unsafeIndex src i) >> loop (d+1) (i+1)++empty_ :: Block ()+empty_ = runST $ primitive $ \s1 ->+    case newByteArray# 0# s1           of { (# s2, mba #) ->+    case unsafeFreezeByteArray# mba s2 of { (# s3, ba  #) ->+        (# s3, Block ba #) }}++empty :: UArray ty+empty = UArray 0 0 (UArrayBA $ Block ba) where !(Block ba) = empty_++-- | Append 2 arrays together by creating a new bigger array+append :: PrimType ty => UArray ty -> UArray ty -> UArray ty+append a b+    | la == azero = b+    | lb == azero = a+    | otherwise = runST $ do+        r  <- new (la+lb)+        ma <- unsafeThaw a+        mb <- unsafeThaw b+        copyAt r (Offset 0) ma (Offset 0) la+        copyAt r (sizeAsOffset la) mb (Offset 0) lb+        unsafeFreeze r+  where+    !la = length a+    !lb = length b++concat :: forall ty . PrimType ty => [UArray ty] -> UArray ty+concat original = runST $ do+    r <- new total+    goCopy r 0 original+    unsafeFreeze r+  where+    !total = size 0 original+    -- size+    size !sz []     = sz+    size !sz (x:xs) = size (length x + sz) xs++    zero = Offset 0++    goCopy r = loop+      where+        loop _  []      = pure ()+        loop !i (x:xs) = do+            unsafeCopyAtRO r i x zero lx+            loop (i `offsetPlusE` lx) xs+          where !lx = length x++-- | Create a Block from a UArray.+--+-- Note that because of the slice, the destination block+-- is re-allocated and copied, unless the slice point+-- at the whole array+toBlock :: PrimType ty => UArray ty -> Block ty+toBlock arr@(UArray start len (UArrayBA blk))+    | start == 0 && BLK.length blk == len = blk+    | otherwise                           = toBlock $ copy arr+toBlock arr = toBlock $ copy arr
+ Basement/UArray/Mutable.hs view
@@ -0,0 +1,181 @@+-- |+-- Module      : Basement.UArray.Mutable -- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A simple array abstraction that allow to use typed+-- array of bytes where the array is pinned in memory+-- to allow easy use with Foreign interfaces, ByteString+-- and always aligned to 64 bytes.+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Basement.UArray.Mutable+    ( MUArray(..)+    -- * Property queries+    , sizeInMutableBytesOfContent+    , mutableLength+    , mutableOffset+    , mutableSame+    , onMutableBackend+    -- * Allocation & Copy+    , new+    , newPinned+    , newNative+    , newNative_+    , mutableForeignMem+    , copyAt+    , copyFromPtr+    , copyToPtr+    , sub+    -- , copyAddr+    -- * Reading and Writing cells+    , unsafeWrite+    , unsafeRead+    , write+    , read+    , withMutablePtr+    , withMutablePtrHint+    ) where++import           GHC.Exts+import           GHC.Types+import           GHC.Ptr+import           Basement.Compat.Base+import           Basement.Compat.Primitive+import           Data.Proxy+import           Basement.Types.OffsetSize+import           Basement.Monad+import           Basement.PrimType+import           Basement.FinalPtr+import           Basement.Exception+import qualified Basement.Block         as BLK+import qualified Basement.Block.Mutable as MBLK+import           Basement.Block         (MutableBlock(..))+import           Basement.UArray.Base hiding (empty)+import           Basement.Numerical.Subtractive+import           Foreign.Marshal.Utils (copyBytes)++sizeInMutableBytesOfContent :: forall ty s . PrimType ty => MUArray ty s -> CountOf Word8+sizeInMutableBytesOfContent _ = primSizeInBytes (Proxy :: Proxy ty)+{-# INLINE sizeInMutableBytesOfContent #-}++-- | read a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+read :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Offset ty -> prim ty+read array n+    | isOutOfBound n len = primOutOfBound OOB_Read n len+    | otherwise          = unsafeRead array n+  where len = mutableLength array+{-# INLINE read #-}++-- | Write to a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+write :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()+write array n val+    | isOutOfBound n len = primOutOfBound OOB_Write n len+    | otherwise          = unsafeWrite array n val+  where+    len = mutableLength array+{-# INLINE write #-}++empty :: (PrimType ty, PrimMonad prim) => prim (MUArray ty (PrimState prim))+empty = MUArray 0 0 . MUArrayMBA <$> MBLK.mutableEmpty++mutableSame :: MUArray ty st -> MUArray ty st -> Bool+mutableSame (MUArray sa ea (MUArrayMBA (MutableBlock ma))) (MUArray sb eb (MUArrayMBA (MutableBlock mb))) = (sa == sb) && (ea == eb) && bool# (sameMutableByteArray# ma mb)+mutableSame (MUArray s1 e1 (MUArrayAddr f1)) (MUArray s2 e2 (MUArrayAddr f2)) = (s1 == s2) && (e1 == e2) && finalPtrSameMemory f1 f2+mutableSame _ _ = False++mutableForeignMem :: (PrimMonad prim, PrimType ty)+                  => FinalPtr ty -- ^ the start pointer with a finalizer+                  -> Int         -- ^ the number of elements (in elements, not bytes)+                  -> prim (MUArray ty (PrimState prim))+mutableForeignMem fptr nb = pure $ MUArray (Offset 0) (CountOf nb) (MUArrayAddr fptr)++sub :: (PrimMonad prim, PrimType ty)+    => MUArray ty (PrimState prim)+    -> Int -- The number of elements to drop ahead+    -> Int -- Then the number of element to retain+    -> prim (MUArray ty (PrimState prim))+sub (MUArray start sz back) dropElems' takeElems+    | takeElems <= 0 = empty+    | Just keepElems <- sz - dropElems, keepElems > 0 +                     = pure $ MUArray (start `offsetPlusE` dropElems) (min (CountOf takeElems) keepElems) back+    | otherwise      = empty+  where+    dropElems = max 0 (CountOf dropElems')+++-- | return the numbers of elements in a mutable array+mutableLength :: PrimType ty => MUArray ty st -> CountOf ty+mutableLength (MUArray _ end _)   = end++withMutablePtrHint :: forall ty prim a . (PrimMonad prim, PrimType ty)+                   => Bool+                   -> Bool+                   -> MUArray ty (PrimState prim)+                   -> (Ptr ty -> prim a)+                   -> prim a+withMutablePtrHint skipCopy skipCopyBack (MUArray start _ back) f =+    case back of+        MUArrayAddr fptr -> withFinalPtr fptr (\ptr -> f (ptr `plusPtr` os))+        MUArrayMBA mb    -> MBLK.withMutablePtrHint skipCopy skipCopyBack mb $ \ptr -> f (ptr `plusPtr` os)+  where+    sz           = primSizeInBytes (Proxy :: Proxy ty)+    !(Offset os) = offsetOfE sz start++-- | Create a pointer on the beginning of the mutable array+-- and call a function 'f'.+--+-- The mutable buffer can be mutated by the 'f' function+-- and the change will be reflected in the mutable array+--+-- If the mutable array is unpinned, a trampoline buffer+-- is created and the data is only copied when 'f' return.+withMutablePtr :: (PrimMonad prim, PrimType ty)+               => MUArray ty (PrimState prim)+               -> (Ptr ty -> prim a)+               -> prim a+withMutablePtr = withMutablePtrHint False False++-- | Copy from a pointer, @count@ elements, into the mutable array+copyFromPtr :: forall prim ty . (PrimMonad prim, PrimType ty)+            => Ptr ty -> CountOf ty -> MUArray ty (PrimState prim) -> prim ()+copyFromPtr src@(Ptr src#) count marr+    | count > arrSz = primOutOfBound OOB_MemCopy (sizeAsOffset count) arrSz+    | otherwise     = onMutableBackend copyNative copyPtr marr+  where+    arrSz = mutableLength marr+    ofs = mutableOffset marr++    sz = primSizeInBytes (Proxy :: Proxy ty)+    !count'@(CountOf bytes@(I# bytes#)) = sizeOfE sz count+    !off'@(Offset od@(I# od#)) = offsetOfE sz ofs++    copyNative mba = MBLK.unsafeCopyBytesPtr mba off' src count'+    copyPtr fptr = withFinalPtr fptr $ \dst ->+        unsafePrimFromIO $ copyBytes (dst `plusPtr` od) src bytes++-- | Copy all the block content to the memory starting at the destination address+copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)+          => MUArray ty (PrimState prim) -- ^ the source mutable array to copy+          -> Ptr ty                      -- ^ The destination address where the copy is going to start+          -> prim ()+copyToPtr marr dst@(Ptr dst#) = onMutableBackend copyNative copyPtr marr+  where+    copyNative (MutableBlock mba) = primitive $ \s1 ->+        case unsafeFreezeByteArray# mba s1 of+            (# s2, ba #) -> (# copyByteArrayToAddr# ba os# dst# szBytes# s2, () #)+    copyPtr fptr = unsafePrimFromIO $ withFinalPtr fptr $ \ptr ->+        copyBytes dst (ptr `plusPtr` os) szBytes++    !(Offset os@(I# os#)) = offsetInBytes $ mutableOffset marr+    !(CountOf szBytes@(I# szBytes#)) = sizeInBytes $ mutableLength marr++mutableOffset :: MUArray ty st -> Offset ty+mutableOffset (MUArray ofs _ _) = ofs
+ Basement/UTF8/Base.hs view
@@ -0,0 +1,235 @@+-- |+-- Module      : Basement.String+-- License     : BSD-style+-- Maintainer  : Foundation+--+-- A String type backed by a UTF8 encoded byte array and all the necessary+-- functions to manipulate the string.+--+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE CPP                        #-}+module Basement.UTF8.Base+    where++import           GHC.ST (ST, runST)+import           GHC.Types+import           GHC.Word+import           GHC.Prim+import           GHC.Exts (build)+import           Basement.Compat.Base+import           Basement.Numerical.Additive+import           Basement.Compat.Bifunctor+import           Basement.NormalForm+import           Basement.Types.OffsetSize+import           Basement.PrimType+import           Basement.Monad+import           Basement.FinalPtr+import           Basement.UTF8.Helper+import           Basement.UTF8.Types+import qualified Basement.Alg.UTF8         as UTF8+import           Basement.UArray           (UArray)+import           Basement.Block            (MutableBlock)+import qualified Basement.Block.Mutable    as BLK+import qualified Basement.UArray           as Vec+import qualified Basement.UArray           as C+import qualified Basement.UArray.Mutable   as MVec+import           Basement.UArray.Base   as Vec (offset, pureST, onBackend, ValidRange(..), offsetsValidRange)+import           GHC.CString                        (unpackCString#, unpackCStringUtf8#)++import           Data.Data+import           Basement.Compat.ExtList as List+import           Basement.Compat.Semigroup (Semigroup)++-- | Opaque packed array of characters in the UTF8 encoding+newtype String = String (UArray Word8)+    deriving (Typeable, Semigroup, Monoid, Eq, Ord)++-- | Mutable String Buffer.+--+-- Use as an *append* buffer, as UTF8 variable encoding+-- doesn't really allow to change previously written+-- character without potentially shifting bytes.+newtype MutableString st = MutableString (MVec.MUArray Word8 st)+    deriving (Typeable)++instance Show String where+    show = show . sToList+instance IsString String where+    fromString = sFromList+instance IsList String where+    type Item String = Char+    fromList = sFromList+    toList = sToList++instance Data String where+    toConstr s   = mkConstr stringType (show s) [] Prefix+    dataTypeOf _ = stringType+    gunfold _ _  = error "gunfold"++instance NormalForm String where+    toNormalForm (String ba) = toNormalForm ba++stringType :: DataType+stringType = mkNoRepType "Foundation.String"++-- | size in bytes.+--+-- this size is available in o(1)+size :: String -> CountOf Word8+size (String ba) = Vec.length ba++-- | Convert a String to a list of characters+--+-- The list is lazily created as evaluation needed+sToList :: String -> [Char]+sToList (String arr) = Vec.onBackend onBA onAddr arr+  where+    (Vec.ValidRange !start !end) = Vec.offsetsValidRange arr+    onBA ba@(BLK.Block _) = loop start+      where+        loop !idx+            | idx == end = []+            | otherwise  = let !(Step c idx') = UTF8.next ba idx in c : loop idx'+    onAddr fptr ptr@(Ptr _) = pureST (loop start)+      where+        loop !idx+            | idx == end = []+            | otherwise  = let !(Step c idx') = UTF8.next ptr idx in c : loop idx'+{-# NOINLINE sToList #-}++sToListStream (String arr) k z = Vec.onBackend onBA onAddr arr+  where+    (Vec.ValidRange !start !end) = Vec.offsetsValidRange arr+    onBA ba@(BLK.Block _) = loop start+      where+        loop !idx+            | idx == end = z+            | otherwise  = let !(Step c idx') = UTF8.next ba idx in c `k` loop idx'+    onAddr fptr ptr@(Ptr _) = pureST (loop start)+      where+        loop !idx+            | idx == end = z+            | otherwise  = let !(Step c idx') = UTF8.next ptr idx in c `k` loop idx'++{-# RULES "String sToList" [~1] forall s . sToList s = build (\ k z -> sToListStream s k z) #-}+{-# RULES "String toList" [~1] forall s . toList s = build (\ k z -> sToListStream s k z) #-}++{-# RULES "String sFromList" forall s .  sFromList (unpackCString# s) = fromModified s #-}+{-# RULES "String sFromList" forall s .  sFromList (unpackCStringUtf8# s) = fromModified s #-}++-- | assuming the given Addr# is a valid modified UTF-8 sequence of bytes+--+-- We only modify the given Unicode Null-character (0xC080) into a null bytes+--+-- FIXME: need to evaluate the kind of modified UTF8 GHC is actually expecting+-- it is plausible they only handle the Null Bytes, which this function actually+-- does.+fromModified :: Addr# -> String+fromModified addr = countAndCopy 0 0+  where+    countAndCopy :: CountOf Word8 -> Offset Word8 -> String+    countAndCopy count ofs =+        case primAddrIndex addr ofs of+            0x00 -> runST $ do+                        mb <- MVec.newNative_ count (copy count)+                        String <$> Vec.unsafeFreeze mb+            0xC0 -> case primAddrIndex addr (ofs+1) of+                        0x80 -> countAndCopy (count+1) (ofs+2)+                        _    -> countAndCopy (count+2) (ofs+2)+            _    -> countAndCopy (count+1) (ofs+1)++    copy :: CountOf Word8 -> MutableBlock Word8 st -> ST st ()+    copy count mba = loop 0 0+      where loop o i+                | o .==# count = pure ()+                | otherwise    =+                    case primAddrIndex addr i of+                        0xC0 -> case primAddrIndex addr (i+1) of+                                    0x80 -> BLK.unsafeWrite mba o 0x00 >> loop (o+1) (i+2)+                                    b2   -> BLK.unsafeWrite mba o 0xC0 >> BLK.unsafeWrite mba (o+1) b2 >> loop (o+2) (i+2)+                        b1   -> BLK.unsafeWrite mba o b1 >> loop (o+1) (i+1)+++-- | Create a new String from a list of characters+--+-- The list is strictly and fully evaluated before+-- creating the new String, as the size need to be+-- computed before filling.+sFromList :: [Char] -> String+sFromList l = runST (new bytes >>= startCopy)+  where+    -- count how many bytes+    !bytes = List.sum $ fmap (charToBytes . fromEnum) l++    startCopy :: MutableString (PrimState (ST st)) -> ST st String+    startCopy ms = loop 0 l+      where+        loop _   []     = freeze ms+        loop idx (c:xs) = write ms idx c >>= \idx' -> loop idx' xs+{-# INLINE [0] sFromList #-}++next :: String -> Offset8 -> Step+next (String array) !n = Vec.onBackend nextBA nextAddr array+  where+    !start = Vec.offset array+    reoffset (Step a ofs) = Step a (ofs `offsetSub` start)+    nextBA ba@(BLK.Block _) = reoffset (UTF8.next ba (start + n))+    nextAddr _ ptr@(Ptr _)  = pureST $ reoffset (UTF8.next ptr (start + n))++prev :: String -> Offset8 -> StepBack+prev (String array) !n = Vec.onBackend prevBA prevAddr array+  where+    !start = Vec.offset array+    reoffset (StepBack a ofs) = StepBack a (ofs `offsetSub` start)+    prevBA ba@(BLK.Block _) = reoffset (UTF8.prev ba (start + n))+    prevAddr _ ptr@(Ptr _)  = pureST $ reoffset (UTF8.prev ptr (start + n))++-- A variant of 'next' when you want the next character+-- to be ASCII only.+nextAscii :: String -> Offset8 -> StepASCII+nextAscii (String ba) n = StepASCII w+  where+    !w = Vec.unsafeIndex ba n++expectAscii :: String -> Offset8 -> Word8 -> Bool+expectAscii (String ba) n v = Vec.unsafeIndex ba n == v+{-# INLINE expectAscii #-}++write :: PrimMonad prim => MutableString (PrimState prim) -> Offset8 -> Char -> prim Offset8+write (MutableString marray) ofs c =+    MVec.onMutableBackend (\mba@(BLK.MutableBlock _) -> UTF8.writeUTF8 mba (start + ofs) c)+                          (\fptr -> withFinalPtr fptr $ \ptr@(Ptr _) -> UTF8.writeUTF8 ptr (start + ofs) c)+                          marray+  where start = MVec.mutableOffset marray++-- | Allocate a MutableString of a specific size in bytes.+new :: PrimMonad prim+    => CountOf Word8 -- ^ in number of bytes, not of elements.+    -> prim (MutableString (PrimState prim))+new n = MutableString `fmap` MVec.new n++newNative :: PrimMonad prim+          => CountOf Word8 -- ^ in number of bytes, not of elements.+          -> (MutableBlock Word8 (PrimState prim) -> prim a)+          -> prim (a, MutableString (PrimState prim))+newNative n f = second MutableString `fmap` MVec.newNative n f++newNative_ :: PrimMonad prim+           => CountOf Word8 -- ^ in number of bytes, not of elements.+           -> (MutableBlock Word8 (PrimState prim) -> prim ())+           -> prim (MutableString (PrimState prim))+newNative_ n f = MutableString `fmap` MVec.newNative_ n f++freeze :: PrimMonad prim => MutableString (PrimState prim) -> prim String+freeze (MutableString mba) = String `fmap` C.unsafeFreeze mba+{-# INLINE freeze #-}++freezeShrink :: PrimMonad prim+             => CountOf Word8+             -> MutableString (PrimState prim)+             -> prim String+freezeShrink n (MutableString mba) = String `fmap` C.unsafeFreezeShrink mba n
+ Basement/UTF8/Helper.hs view
@@ -0,0 +1,233 @@+-- |+-- Module      : Basement.UTF8.Helper+-- License     : BSD-style+-- Maintainer  : Foundation+--+-- Some low level helpers to use UTF8+--+-- Most helpers are lowlevel and unsafe, don't use+-- directly.+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE CPP                        #-}+module Basement.UTF8.Helper+    where++import           Basement.Compat.Base+import           Basement.Compat.Primitive+import           Basement.HeadHackageUtils+import           Basement.Types.OffsetSize+import           Basement.UTF8.Types+import           GHC.Prim+import           GHC.Types+import           GHC.Word++-- mask an UTF8 continuation byte (stripping the leading 10 and returning 6 valid bits)+maskContinuation# :: Word# -> Word#+maskContinuation# v = and# v 0x3f##+{-# INLINE maskContinuation# #-}++-- mask a UTF8 header for 2 bytes encoding (110xxxxx and 5 valid bits)+maskHeader2# :: Word# -> Word#+maskHeader2# h = and# h 0x1f##+{-# INLINE maskHeader2# #-}++-- mask a UTF8 header for 3 bytes encoding (1110xxxx and 4 valid bits)+maskHeader3# :: Word# -> Word#+maskHeader3# h = and# h 0xf##+{-# INLINE maskHeader3# #-}++-- mask a UTF8 header for 4 bytes encoding (11110xxx and 3 valid bits)+maskHeader4# :: Word# -> Word#+maskHeader4# h = and# h 0x7##+{-# INLINE maskHeader4# #-}++or3# :: Word# -> Word# -> Word# -> Word#+or3# a b c = or# a (or# b c)+{-# INLINE or3# #-}++or4# :: Word# -> Word# -> Word# -> Word# -> Word#+or4# a b c d = or# (or# a b) (or# c d)+{-# INLINE or4# #-}++toChar# :: Word# -> Char+toChar# w = C# (chr# (word2Int# w))+{-# INLINE toChar# #-}++toChar1 :: StepASCII -> Char+toChar1 (StepASCII (W8# w)) = toChar# (word8ToWordCompat# w)++toChar2 :: StepASCII -> Word8 -> Char+toChar2 (StepASCII (W8# w1)) (W8# w2) =+    toChar# (or# (uncheckedShiftL# (maskHeader2# (word8ToWordCompat# w1)) 6#) (maskContinuation# (word8ToWordCompat# w2)))++toChar3 :: StepASCII -> Word8 -> Word8 -> Char+toChar3 (StepASCII (W8# w1)) (W8# w2) (W8# w3) =+    toChar# (or3# (uncheckedShiftL# (maskHeader3# (word8ToWordCompat# w1)) 12#)+                  (uncheckedShiftL# (maskContinuation# (word8ToWordCompat# w2)) 6#)+                  (maskContinuation# (word8ToWordCompat# w3))+            )++toChar4 :: StepASCII -> Word8 -> Word8 -> Word8 -> Char+toChar4 (StepASCII (W8# w1)) (W8# w2) (W8# w3) (W8# w4) =+    toChar# (or4# (uncheckedShiftL# (maskHeader4# (word8ToWordCompat# w1)) 18#)+                  (uncheckedShiftL# (maskContinuation# (word8ToWordCompat# w2)) 12#)+                  (uncheckedShiftL# (maskContinuation# (word8ToWordCompat# w3)) 6#)+                  (maskContinuation# (word8ToWordCompat# w4))+            )++-- | Different way to encode a Character in UTF8 represented as an ADT+data UTF8Char =+      UTF8_1 {-# UNPACK #-} !Word8+    | UTF8_2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+    | UTF8_3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+    | UTF8_4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8++-- | Transform a Unicode code point 'Char' into+--+-- note that we expect here a valid unicode code point in the *allowed* range.+-- bits will be lost if going above 0x10ffff+asUTF8Char :: Char -> UTF8Char+asUTF8Char !(C# c)+  | bool# (ltWord# x 0x80##   ) = encode1+  | bool# (ltWord# x 0x800##  ) = encode2+  | bool# (ltWord# x 0x10000##) = encode3+  | otherwise                   = encode4+    where+      !x = int2Word# (ord# c)++      encode1 = UTF8_1 (W8# (wordToWord8Compat# x))+      encode2 =+          let !x1 = W8# (wordToWord8Compat# (or# (uncheckedShiftRL# x 6#) 0xc0##))+              !x2 = toContinuation x+           in UTF8_2 x1 x2+      encode3 =+          let !x1 = W8# (wordToWord8Compat# (or# (uncheckedShiftRL# x 12#) 0xe0##))+              !x2 = toContinuation (uncheckedShiftRL# x 6#)+              !x3 = toContinuation x+           in UTF8_3 x1 x2 x3+      encode4 =+          let !x1 = W8# (wordToWord8Compat# (or# (uncheckedShiftRL# x 18#) 0xf0##))+              !x2 = toContinuation (uncheckedShiftRL# x 12#)+              !x3 = toContinuation (uncheckedShiftRL# x 6#)+              !x4 = toContinuation x+           in UTF8_4 x1 x2 x3 x4++      toContinuation :: Word# -> Word8+      toContinuation w = W8# (wordToWord8Compat# (or# (and# w 0x3f##) 0x80##))+      {-# INLINE toContinuation #-}++-- given the encoding of UTF8 Char, get the number of bytes of this sequence+numBytes :: UTF8Char -> CountOf Word8+numBytes UTF8_1{} = CountOf 1+numBytes UTF8_2{} = CountOf 2+numBytes UTF8_3{} = CountOf 3+numBytes UTF8_4{} = CountOf 4++-- given the leading byte of a utf8 sequence, get the number of bytes of this sequence+skipNextHeaderValue :: Word8 -> CountOf Word8+skipNextHeaderValue !x+    | x < 0xC0  = CountOf 1 -- 0b11000000+    | x < 0xE0  = CountOf 2 -- 0b11100000+    | x < 0xF0  = CountOf 3 -- 0b11110000+    | otherwise = CountOf 4+{-# INLINE skipNextHeaderValue #-}++headerIsAscii :: StepASCII -> Bool+headerIsAscii (StepASCII x) = x < 0x80++charToBytes :: Int -> CountOf Word8+charToBytes c+    | c < 0x80     = CountOf 1+    | c < 0x800    = CountOf 2+    | c < 0x10000  = CountOf 3+    | c < 0x110000 = CountOf 4+    | otherwise    = error ("invalid code point: " `mappend` show c)++-- | Encode a Char into a CharUTF8+encodeCharUTF8 :: Char -> CharUTF8+encodeCharUTF8 !(C# c)+    | bool# (ltWord# x 0x80##   ) = CharUTF8 (W32# (wordToWord32Compat# x))+    | bool# (ltWord# x 0x800##  ) = CharUTF8 encode2+    | bool# (ltWord# x 0x10000##) = CharUTF8 encode3+    | otherwise                   = CharUTF8 encode4+  where+    !x = int2Word# (ord# c)++    -- clearing mask, clearing all the bits that need to be clear as per the UTF8 encoding+    mask2 = 0x0000bfdf## -- 1 continuation , 5 bits header+    mask3 = 0x00bfbfef## -- 2 continuations, 4 bits header+    mask4 = 0xbfbfbff7## -- 3 continuations, 3 bits header++    -- setting mask, settings all the bits that need to be set per the UTF8 encoding+    set2  = 0x000080c0## -- 10xxxxxx     110xxxxx+    set3  = 0x008080e0## -- 10xxxxxx * 2 1110xxxx+    set4  = 0x808080f0## -- 10xxxxxx * 3 11111xxx++    encode2 = W32# (wordToWord32Compat# (and# mask2 (or3# set2+                                     (uncheckedShiftRL# x 6#) -- 5 bits to 1st byte+                                     (uncheckedShiftL# x 8# ) -- move lowest bits to the 2nd byte+                               )))+    encode3 = W32# (wordToWord32Compat# (and# mask3 (or4# set3+                                     (uncheckedShiftRL# x 12#) -- 4 bits to 1st byte+                                     (and# 0x3f00## (uncheckedShiftL# x 2#)) -- 6 bits to the 2nd byte+                                     (uncheckedShiftL# x 16# ) -- move lowest bits to the 3rd byte+                               )))+    encode4 = W32# (wordToWord32Compat# (and# mask4 (or4# set4+                                     (uncheckedShiftRL# x 18#) -- 3 bits to 1st byte+                                     (or# (and# 0x3f00## (uncheckedShiftRL# x 4#))   -- 6 bits to the 2nd byte+                                          (and# 0x3f0000## (uncheckedShiftL# x 10#)) -- 6 bits to the 3nd byte+                                     )+                                     (uncheckedShiftL# x 24# ) -- move lowest bits to the 4rd byte+                               )))++-- | decode a CharUTF8 into a Char+--+-- If the value inside a CharUTF8 is not properly encoded, this will result in violation+-- of the Char invariants+decodeCharUTF8 :: CharUTF8 -> Char+decodeCharUTF8 c@(CharUTF8 !(W32# w))+    | isCharUTF8Case1 c = toChar# (word32ToWordCompat# w)+    | isCharUTF8Case2 c = encode2+    | isCharUTF8Case3 c = encode3+    | otherwise         = encode4+  where+    encode2 =+        toChar# (or# (uncheckedShiftL# (maskHeader2# (word32ToWordCompat# w)) 6#)+                     (maskContinuation# (uncheckedShiftRL# (word32ToWordCompat# w) 8#))+                )+    encode3 =+        toChar# (or3# (uncheckedShiftL# (maskHeader3# (word32ToWordCompat# w)) 12#)+                      (uncheckedShiftRL# (and# 0x3f00## (word32ToWordCompat# w)) 8#)+                      (maskContinuation# (uncheckedShiftRL# (word32ToWordCompat# w) 16#))+                )+    encode4 =+        toChar# (or4# (uncheckedShiftL#  (maskHeader4# (word32ToWordCompat# w)) 18#)+                      (uncheckedShiftRL# (and# 0x3f00## (word32ToWordCompat# w)) 10#)+                      (uncheckedShiftL#  (and# 0x3f0000## (word32ToWordCompat# w)) 4#)+                      (maskContinuation# (uncheckedShiftRL# (word32ToWordCompat# w) 24#))+                )++    -- clearing mask, removing all UTF8 metadata and keeping only signal (content)+    --maskContent2 = 0x00003f1f## -- 1 continuation , 5 bits header+    --maskContent3 = 0x003f3f0f## -- 2 continuations, 4 bits header+    --maskContent4 = 0x3f3f3f07## -- 3 continuations, 3 bits header++isCharUTF8Case1 :: CharUTF8 -> Bool+isCharUTF8Case1 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# (word32ToWordCompat# w) 0x80##) 0##)+{-# INLINE isCharUTF8Case1 #-}++isCharUTF8Case2 :: CharUTF8 -> Bool+isCharUTF8Case2 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# (word32ToWordCompat# w) 0x20##) 0##)+{-# INLINE isCharUTF8Case2 #-}++isCharUTF8Case3 :: CharUTF8 -> Bool+isCharUTF8Case3 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# (word32ToWordCompat# w) 0x10##) 0##)+{-# INLINE isCharUTF8Case3 #-}++isCharUTF8Case4 :: CharUTF8 -> Bool+isCharUTF8Case4 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# (word32ToWordCompat# w) 0x08##) 0##)+{-# INLINE isCharUTF8Case4 #-}
+ Basement/UTF8/Table.hs view
@@ -0,0 +1,111 @@+-- |+-- Module      : Basement.UTF8.Table+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- UTF8 lookup tables for fast continuation & nb bytes per header queries+{-# LANGUAGE MagicHash #-}+module Basement.UTF8.Table+    ( isContinuation+    , isContinuation2+    , isContinuation3+    , getNbBytes+    , isContinuation#+    , getNbBytes#+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.Word+import           Basement.Compat.Base+import           Basement.Compat.Primitive+import           Basement.HeadHackageUtils+import           Basement.UTF8.Types (StepASCII(..))++-- | Check if the byte is a continuation byte+isContinuation :: Word8 -> Bool+isContinuation (W8# w) = isContinuation# (word8ToWordCompat# w)+{-# INLINE isContinuation #-}++isContinuation2 :: Word8 -> Word8 -> Bool+isContinuation2 (W8# w1) (W8# w2) =+    bool# (mask (word8ToWordCompat# w1) `andI#` mask (word8ToWordCompat# w2))+  where+    mask v = (and# 0xC0## v) `eqWord#` 0x80##+{-# INLINE isContinuation2 #-}++isContinuation3 :: Word8 -> Word8 -> Word8 -> Bool+isContinuation3 (W8# w1) (W8# w2) (W8# w3) =+    bool# (mask (word8ToWordCompat# w1)) && bool# (mask (word8ToWordCompat# w2)) && bool# (mask (word8ToWordCompat# w3))+  where+    mask v = (and# 0xC0## v) `eqWord#` 0x80##+{-# INLINE isContinuation3 #-}++-- | Number of bytes associated with a specific header byte+--+-- If the header byte is invalid then NbBytesInvalid is returned,+data NbBytesCont = NbBytesInvalid | NbBytesCont0 | NbBytesCont1 | NbBytesCont2 | NbBytesCont3++-- | Identical to 'NbBytesCont' but doesn't allow to represent any failure.+--+-- Only use in validated place+data NbBytesCont_ = NbBytesCont0_ | NbBytesCont1_ | NbBytesCont2_ | NbBytesCont3_++-- | Get the number of following bytes given the first byte of a UTF8 sequence.+getNbBytes :: StepASCII -> Int+getNbBytes (StepASCII (W8# w)) = I# (getNbBytes# (word8ToWordCompat# w))+{-# INLINE getNbBytes #-}++-- | Check if the byte is a continuation byte+isContinuation# :: Word# -> Bool+isContinuation# w = W# (word8ToWordCompat# (indexWord8OffAddr# (unTable contTable) (word2Int# w))) == W# 0##+{-# INLINE isContinuation# #-}++-- | Get the number of following bytes given the first byte of a UTF8 sequence.+getNbBytes# :: Word# -> Int#+getNbBytes# w = word2Int# (word8ToWordCompat# (indexWord8OffAddr# (unTable headTable) (word2Int# w)))+{-# INLINE getNbBytes# #-}++data Table = Table { unTable :: !Addr# }++contTable :: Table+contTable = Table+        "\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01"#+{-# NOINLINE contTable #-}++headTable :: Table+headTable = Table+        "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\+        \\x03\x03\x03\x03\x03\x03\x03\x03\xff\xff\xff\xff\xff\xff\xff\xff"#+{-# NOINLINE headTable #-}
+ Basement/UTF8/Types.hs view
@@ -0,0 +1,68 @@+module Basement.UTF8.Types+    (+    -- * Stepper+      Step(..)+    , StepBack(..)+    , StepASCII(..)+    , StepDigit(..)+    , isValidStepASCII+    , isValidStepDigit+    -- * Unicode Errors+    , ValidationFailure(..)+    -- * UTF8 Encoded 'Char'+    , CharUTF8(..)+    -- * Case Conversion+    , CM (..)+    ) where++import           Basement.Compat.Base+import           Basement.Types.OffsetSize++-- | Step when walking a String+--+-- this is a return value composed of :+-- * the unicode code point read (Char) which need to be+--   between 0 and 0x10ffff (inclusive)+-- * The next offset to start reading the next unicode code point (or end)+data Step = Step {-# UNPACK #-} !Char {-# UNPACK #-} !(Offset Word8)++-- | Similar to Step but used when processing the string from the end.+--+-- The stepper is thus the previous character, and the offset of+-- the beginning of the previous character+data StepBack = StepBack {-# UNPACK #-} !Char {-# UNPACK #-} !(Offset Word8)++-- | Step when processing digits. the value is between 0 and 9 to be valid+newtype StepDigit = StepDigit Word8++-- | Step when processing ASCII character+newtype StepASCII = StepASCII { stepAsciiRawValue :: Word8 }++-- | Specialized tuple used for case mapping.+data CM = CM {-# UNPACK #-} !Char {-# UNPACK #-} !Char {-# UNPACK #-} !Char deriving (Eq)++-- | Represent an already encoded UTF8 Char where the the lowest 8 bits is the start of the+-- sequence. If this contains a multi bytes sequence then each higher 8 bits are filled with+-- the remaining sequence 8 bits per 8 bits.+--+-- For example:+-- 'A' => U+0041  => 41          => 0x00000041+-- '€  => U+20AC  => E2 82 AC    => 0x00AC82E2+-- '𐍈' => U+10348 => F0 90 8D 88 => 0x888D90F0+--+newtype CharUTF8 = CharUTF8 Word32++isValidStepASCII :: StepASCII -> Bool+isValidStepASCII (StepASCII w) = w < 0x80++isValidStepDigit :: StepDigit -> Bool+isValidStepDigit (StepDigit w) = w < 0xa++-- | Possible failure related to validating bytes of UTF8 sequences.+data ValidationFailure = InvalidHeader+                       | InvalidContinuation+                       | MissingByte+                       | BuildingFailure+                       deriving (Show,Eq,Typeable)++instance Exception ValidationFailure
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2015-2017 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2017-2019 Foundation Maintainers++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ basement-cd.cabal view
@@ -0,0 +1,163 @@+name:                basement-cd+version:             0.0.12.1+synopsis:            Foundation scrap box of array & string+description:         Foundation most basic primitives without any dependencies+license:             BSD3+license-file:        LICENSE+copyright:           2015-2017 Vincent Hanquez <vincent@snarc.org>+                   , 2017-2018 Foundation Maintainers+maintainer:          chris@chrisdornan.com+category:            Web+build-type:          Simple+homepage:            https://github.com/cdornan/basement-cd#readme+bug-reports:         https://github.com/cdornan/basement-cd/issues+cabal-version:       1.18+extra-source-files:  cbits/*.h cbits/basement_rts.c++source-repository head+  type: git+  location: https://github.com/cdornan/basement-cd+  subdir: basement++library+  hs-source-dirs:    .+  exposed-modules:+                     Basement.Imports++                     Basement.Base16+                     Basement.Bindings.Memory+                     Basement.Endianness+                     Basement.Environment+                     Basement.PrimType++                     Basement.Exception+                     Basement.Cast+                     Basement.From++                     Basement.Types.Char7+                     Basement.Types.CharUTF8+                     Basement.Types.OffsetSize+                     Basement.Types.Ptr+                     Basement.Types.AsciiString+                     Basement.Types.Word128+                     Basement.Types.Word256+                     Basement.Monad+                     Basement.MutableBuilder+                     Basement.FinalPtr++                     Basement.Nat++                     -- Extended Types+                     Basement.BoxedArray+                     Basement.Block+                     Basement.Block.Mutable+                     Basement.Block.Builder+                     Basement.UArray+                     Basement.UArray.Mutable+                     Basement.String+                     Basement.String.Builder+                     Basement.NonEmpty++                     -- Extended Types with explicit type level size+                     Basement.Sized.Block+                     Basement.Sized.UVect+                     Basement.Sized.Vect+                     Basement.Sized.List+                     Basement.BlockN++                     -- Utils+                     Basement.NormalForm+                     Basement.These++                     -- Terminal+                     Basement.Terminal+                     Basement.Terminal.ANSI++                     -- numeric stuff+                     Basement.IntegralConv+                     Basement.Floating+                     Basement.Numerical.Number+                     Basement.Numerical.Additive+                     Basement.Numerical.Subtractive+                     Basement.Numerical.Multiplicative+                     Basement.Bounded++                     -- exported algorithms+                     Basement.Alg.XorShift++                     -- compat / base redefinition+                     Basement.Compat.AMP+                     Basement.Compat.Base+                     Basement.Compat.Bifunctor+                     Basement.Compat.CallStack+                     Basement.Compat.C.Types+                     Basement.Compat.ExtList+                     Basement.Compat.IsList+                     Basement.Compat.Identity+                     Basement.Compat.Primitive+                     Basement.Compat.PrimTypes+                     Basement.Compat.MonadTrans+                     Basement.Compat.Semigroup+                     Basement.Compat.Natural+                     Basement.Compat.NumLiteral+                     Basement.Compat.Typeable++                     Basement.Bits++  other-modules:+                     Basement.Error+                     Basement.Show+                     Basement.Runtime++                     Basement.Alg.Class+                     Basement.Alg.Mutable+                     Basement.Alg.PrimArray++                     Basement.Alg.UTF8+                     Basement.Alg.String++                     Basement.Numerical.Conversion++                     Basement.Block.Base++                     Basement.UTF8.Base+                     Basement.UTF8.Helper+                     Basement.UTF8.Table+                     Basement.UTF8.Types++                     Basement.UArray.Base++                     Basement.String.CaseMapping+                     Basement.String.Encoding.Encoding+                     Basement.String.Encoding.UTF16+                     Basement.String.Encoding.UTF32+                     Basement.String.Encoding.ASCII7+                     Basement.String.Encoding.ISO_8859_1++                     Basement.Terminal.Size++                     Basement.HeadHackageUtils++  -- support and dependencies+  if impl(ghc < 8.0)+    buildable: False+  else+    build-depends:     base >=4.9 && <4.17+                     , ghc-prim+    if os(windows)+      build-depends:   Win32++  default-language:    Haskell2010+  default-extensions: NoImplicitPrelude+                      RebindableSyntax+                      TypeFamilies+                      BangPatterns+                      DeriveDataTypeable+  if (arch(i386) || arch(x86_64))+    cpp-options: -DARCH_IS_LITTLE_ENDIAN+  else+    cpp-options: -DARCH_IS_UNKNOWN_ENDIAN+  include-dirs:      cbits+  c-sources:         cbits/foundation_mem.c+  if impl(ghc < 8.2)+    c-sources:       cbits/basement_rts.c
+ cbits/basement_rts.c view
@@ -0,0 +1,8 @@+#include "Rts.h"++#if __GLASGOW_HASKELL__ < 802+int basement_is_bytearray_pinned(void *p)+{+    return Bdescr((StgPtr) p)->flags & BF_PINNED;+}+#endif
+ cbits/foundation_mem.c view
@@ -0,0 +1,14 @@+#include <string.h>+#include <stdint.h>+#include "foundation_prim.h"++int _foundation_memcmp(const void *s1, FsOffset off1, const void *s2, FsOffset off2, FsCountOf n)+{+	return memcmp(s1 + off1, s2 + off2, n);+}++FsOffset _foundation_mem_findbyte(uint8_t * const arr, FsOffset startofs, FsOffset endofs, uint8_t ty)+{+    uint8_t *r = memchr(arr + startofs, ty, endofs - startofs);+    return ((r == NULL) ? endofs : r - arr);+}
+ cbits/foundation_prim.h view
@@ -0,0 +1,8 @@+#ifndef FOUNDATION_PRIM_H+#define FOUNDATION_PRIM_H+#include "Rts.h"++typedef StgInt FsOffset;+typedef StgInt FsCountOf;++#endif
+ cbits/foundation_system.h view
@@ -0,0 +1,60 @@+#ifndef FOUNDATION_SYSTEM_H+# define FOUNDATION_SYSTEM_H++#ifdef _WIN32+   #define FOUNDATION_SYSTEM_WINDOWS+   #define FOUNDATION_SYSTEM_API_NO_CLOCK++   //define something for Windows (32-bit and 64-bit, this part is common)+   #ifdef _WIN64+      #define FOUNDATION_SYSTEM_WINDOWS_64+      //define something for Windows (64-bit only)+   #else+      #define FOUNDATION_SYSTEM_WINDOWS_32+      //define something for Windows (32-bit only)+   #endif+#elif __APPLE__+    #include "TargetConditionals.h"+    #include "Availability.h"++    #if TARGET_OS_MAC+      #define FOUNDATION_SYSTEM_UNIX+      #define FOUNDATION_SYSTEM_MACOS++      #if !defined(__MAC_10_12) || __MAC_OS_X_VERSION_MIN_REQUIRED < __MAC_10_12+      #define FOUNDATION_SYSTEM_API_NO_CLOCK+      #endif+      // Other kinds of Mac OS+    #else+    #   error "foundation: system: Unknown Apple platform"+    #endif+#elif __linux__+    #define FOUNDATION_SYSTEM_UNIX+    #define FOUNDATION_SYSTEM_LINUX+    // linux+#elif defined(__FreeBSD__)+    #define FOUNDATION_SYSTEM_UNIX+    #define FOUNDATION_SYSTEM_BSD+    #define FOUNDATION_SYSTEM_FREEBSD+    // freeBSD+#elif defined(__NetBSD__)+    #define FOUNDATION_SYSTEM_UNIX+    #define FOUNDATION_SYSTEM_BSD+    #define FOUNDATION_SYSTEM_NETBSD+    // NetBSD+#elif defined(__OpenBSD__)+    #define FOUNDATION_SYSTEM_UNIX+    #define FOUNDATION_SYSTEM_BSD+    #define FOUNDATION_SYSTEM_OPENBSD+    // OpenBSD+#elif __unix__ // all unices not caught above+    #define FOUNDATION_SYSTEM_UNIX+    // Unix+#elif defined(_POSIX_VERSION)+    #define FOUNDATION_SYSTEM_UNIX+    // POSIX+#else+#   error "foundation: system: Unknown compiler"+#endif++#endif