basement-0.0.11/Basement/0000755000000000000000000000000013506123245013314 5ustar0000000000000000basement-0.0.11/Basement/Alg/0000755000000000000000000000000013506061452014020 5ustar0000000000000000basement-0.0.11/Basement/Bindings/0000755000000000000000000000000013506061452015052 5ustar0000000000000000basement-0.0.11/Basement/Block/0000755000000000000000000000000013506061452014347 5ustar0000000000000000basement-0.0.11/Basement/Compat/0000755000000000000000000000000013506123115014533 5ustar0000000000000000basement-0.0.11/Basement/Compat/C/0000755000000000000000000000000013506061452014722 5ustar0000000000000000basement-0.0.11/Basement/Numerical/0000755000000000000000000000000013506061452015234 5ustar0000000000000000basement-0.0.11/Basement/Sized/0000755000000000000000000000000013506061452014373 5ustar0000000000000000basement-0.0.11/Basement/String/0000755000000000000000000000000013506061452014563 5ustar0000000000000000basement-0.0.11/Basement/String/Encoding/0000755000000000000000000000000013506061452016311 5ustar0000000000000000basement-0.0.11/Basement/Terminal/0000755000000000000000000000000013506061452015070 5ustar0000000000000000basement-0.0.11/Basement/Types/0000755000000000000000000000000013506061452014421 5ustar0000000000000000basement-0.0.11/Basement/UArray/0000755000000000000000000000000013506061452014520 5ustar0000000000000000basement-0.0.11/Basement/UTF8/0000755000000000000000000000000013506061452014043 5ustar0000000000000000basement-0.0.11/cbits/0000755000000000000000000000000013506061452012663 5ustar0000000000000000basement-0.0.11/Basement/Imports.hs0000644000000000000000000000717313506061452015316 0ustar0000000000000000-- | -- Module : Basement.Imports -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Base16.hs0000644000000000000000000000534013506061452014674 0ustar0000000000000000{-# 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.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 = indexWord8OffAddr# table (word2Int# index) {-# INLINE unsafeConvertByte #-} escapeByte :: Word8 -> Base16Escape escapeByte !(W8# b) = Base16Escape (r tableHi b) (r tableLo 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# w 8#) !(# w3, w4 #) = unsafeConvertByte (and# 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# w 24#) !(# w3, w4 #) = unsafeConvertByte (and# (uncheckedShiftRL# w 16#) 0xff##) !(# w5, w6 #) = unsafeConvertByte (and# (uncheckedShiftRL# w 8#) 0xff##) !(# w7, w8 #) = unsafeConvertByte (and# 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-0.0.11/Basement/Bindings/Memory.hs0000644000000000000000000000222713506061452016661 0ustar0000000000000000{-# 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-0.0.11/Basement/Endianness.hs0000644000000000000000000000703713506061452015747 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Environment.hs0000644000000000000000000000100313506061452016147 0ustar0000000000000000module 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-0.0.11/Basement/PrimType.hs0000644000000000000000000010436413506061452015432 0ustar0000000000000000-- Module : Basement.PrimType -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Exception.hs0000644000000000000000000000443613506061452015616 0ustar0000000000000000-- | -- Module : Basement.Exception -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Cast.hs0000644000000000000000000000710313506061452014544 0ustar0000000000000000{-# 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.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# (narrow8Word# (int2Word# i)) instance Cast Int16 Word16 where cast (I16# i) = W16# (narrow16Word# (int2Word# i)) instance Cast Int32 Word32 where cast (I32# i) = W32# (narrow32Word# (int2Word# 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# (narrow8Int# (word2Int# i)) instance Cast Word16 Int16 where cast (W16# i) = I16# (narrow16Int# (word2Int# i)) instance Cast Word32 Int32 where cast (W32# i) = I32# (narrow32Int# (word2Int# 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-0.0.11/Basement/From.hs0000644000000000000000000002466313506061452014567 0ustar0000000000000000{-# 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 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 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# i instance From Int8 Int32 where from (I8# i) = I32# i instance From Int8 Int64 where from (I8# i) = intToInt64 (I# i) instance From Int8 Int where from (I8# i) = I# i instance From Int16 Int32 where from (I16# i) = I32# i instance From Int16 Int64 where from (I16# i) = intToInt64 (I# i) instance From Int16 Int where from (I16# i) = I# i instance From Int32 Int64 where from (I32# i) = intToInt64 (I# i) instance From Int32 Int where from (I32# i) = I# i instance From Int Int64 where from = intToInt64 instance From Word8 Word16 where from (W8# i) = W16# i instance From Word8 Word32 where from (W8# i) = W32# i instance From Word8 Word64 where from (W8# i) = wordToWord64 (W# i) instance From Word8 Word128 where from (W8# i) = Word128 0 (wordToWord64 $ W# i) instance From Word8 Word256 where from (W8# i) = Word256 0 0 0 (wordToWord64 $ W# i) instance From Word8 Word where from (W8# i) = W# i instance From Word8 Int16 where from (W8# w) = I16# (word2Int# w) instance From Word8 Int32 where from (W8# w) = I32# (word2Int# w) instance From Word8 Int64 where from (W8# w) = intToInt64 (I# (word2Int# w)) instance From Word8 Int where from (W8# w) = I# (word2Int# w) instance From Word16 Word32 where from (W16# i) = W32# i instance From Word16 Word64 where from (W16# i) = wordToWord64 (W# i) instance From Word16 Word128 where from (W16# i) = Word128 0 (wordToWord64 $ W# i) instance From Word16 Word256 where from (W16# i) = Word256 0 0 0 (wordToWord64 $ W# i) instance From Word16 Word where from (W16# i) = W# i instance From Word16 Int32 where from (W16# w) = I32# (word2Int# w) instance From Word16 Int64 where from (W16# w) = intToInt64 (I# (word2Int# w)) instance From Word16 Int where from (W16# w) = I# (word2Int# w) instance From Word32 Word64 where from (W32# i) = wordToWord64 (W# i) instance From Word32 Word128 where from (W32# i) = Word128 0 (wordToWord64 $ W# i) instance From Word32 Word256 where from (W32# i) = Word256 0 0 0 (wordToWord64 $ W# i) instance From Word32 Word where from (W32# i) = W# i instance From Word32 Int64 where from (W32# w) = intToInt64 (I# (word2Int# w)) instance From Word32 Int where from (W32# w) = I# (word2Int# 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# (narrow8Word# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32Word# (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# (narrow8Word# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32Word# (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-0.0.11/Basement/Types/Char7.hs0000644000000000000000000000465413506061452015732 0ustar0000000000000000{-# 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#) -- | 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# 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# (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# (and# (int2Word# (ord# c#)) 0x7f##) -- | Convert a 'Byte' to a 'Char7' ignoring the higher bit fromByteMask :: Word8 -> Char7 fromByteMask !(W8# w#) = Char7 $ W8# (and# 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-0.0.11/Basement/Types/CharUTF8.hs0000644000000000000000000000024013506061452016275 0ustar0000000000000000module Basement.Types.CharUTF8 ( CharUTF8(..) , encodeCharUTF8 , decodeCharUTF8 ) where import Basement.UTF8.Types import Basement.UTF8.Helper basement-0.0.11/Basement/Types/OffsetSize.hs0000644000000000000000000002007513506061452017042 0ustar0000000000000000-- | -- Module : Basement.Types.OffsetSize -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Types/Ptr.hs0000644000000000000000000000203313506061452015520 0ustar0000000000000000{-# 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-0.0.11/Basement/Types/AsciiString.hs0000644000000000000000000000425013506061452017175 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Types/Word128.hs0000644000000000000000000001667613506061452016143 0ustar0000000000000000{-# 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-0.0.11/Basement/Types/Word256.hs0000644000000000000000000002653513506061452016140 0ustar0000000000000000{-# 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-0.0.11/Basement/Monad.hs0000644000000000000000000001077013506123123014706 0ustar0000000000000000-- | -- Module : Basement.Monad -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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) -- | 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-0.0.11/Basement/MutableBuilder.hs0000644000000000000000000000233513506061452016554 0ustar0000000000000000{-# 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-0.0.11/Basement/FinalPtr.hs0000644000000000000000000000742513506061452015400 0ustar0000000000000000-- | -- Module : Basement.FinalPtr -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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 GHC.ForeignPtr 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 (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 == 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 :: 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 (castForeignPtr a) withFinalPtrNoTouch :: FinalPtr p -> (Ptr p -> a) -> a withFinalPtrNoTouch (FinalPtr ptr) f = f ptr withFinalPtrNoTouch (FinalForeign fptr) f = f (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 (unsafeForeignPtrToPtr fptr) unsafePrimFromIO (touchForeignPtr fptr) pure r {-# INLINE withFinalPtr #-} touchFinalPtr :: PrimMonad prim => FinalPtr p -> prim () touchFinalPtr (FinalPtr ptr) = primTouch ptr touchFinalPtr (FinalForeign fptr) = unsafePrimFromIO (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-0.0.11/Basement/Nat.hs0000644000000000000000000001123313506061452014373 0ustar0000000000000000{-# 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-0.0.11/Basement/BoxedArray.hs0000644000000000000000000006224613506061452015723 0ustar0000000000000000-- | -- Module : Basement.BoxedArray -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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.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-0.0.11/Basement/Block.hs0000644000000000000000000003417013506061452014710 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Block/Mutable.hs0000644000000000000000000001266313506061452016304 0ustar0000000000000000-- | -- 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< (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-0.0.11/Basement/Block/Builder.hs0000644000000000000000000001131513506061452016272 0ustar0000000000000000-- | -- 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-0.0.11/Basement/UArray.hs0000644000000000000000000010576713506061452015074 0ustar0000000000000000-- | -- Module : Basement.UArray -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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 -- | 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 w unsafeWrite ma dIdx (W8# wHi) unsafeWrite ma (dIdx+1) (W8# 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# a 2#) !x = or# (and# (uncheckedShiftL# a 4#) 0x30##) (uncheckedShiftRL# b 4#) !y = or# (and# (uncheckedShiftL# b 2#) 0x3c##) (uncheckedShiftRL# c 6#) !z = and# 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-0.0.11/Basement/UArray/Mutable.hs0000644000000000000000000001564313506061452016456 0ustar0000000000000000-- | -- Module : Basement.UArray.Mutable -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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.Prim 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-0.0.11/Basement/String.hs0000644000000000000000000016576013506061452015136 0ustar0000000000000000-- | -- Module : Basement.String -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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 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# h of 0# -> (toChar 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# h)) where !(W8# h) = getter off toChar :: Word# -> Char toChar w = C# (chr# (word2Int# w)) decode2 :: Word8 -> Word# decode2 (W8# c1) = or# (uncheckedShiftL# (and# h 0x1f##) 6#) (and# c1 0x3f##) decode3 :: Word8 -> Word8 -> Word# decode3 (W8# c1) (W8# c2) = or# (uncheckedShiftL# (and# h 0xf##) 12#) (or# (uncheckedShiftL# (and# c1 0x3f##) 6#) (and# c2 0x3f##)) decode4 :: Word8 -> Word8 -> Word8 -> Word# decode4 (W8# c1) (W8# c2) (W8# c3) = or# (uncheckedShiftL# (and# h 0x7##) 18#) (or# (uncheckedShiftL# (and# c1 0x3f##) 12#) (or# (uncheckedShiftL# (and# c2 0x3f##) 6#) (and# 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# x) encode2 = do let x1 = or# (uncheckedShiftRL# x 6#) 0xc0## x2 = toContinuation x Vec.builderAppend (W8# x1) >> Vec.builderAppend (W8# x2) encode3 = do let x1 = or# (uncheckedShiftRL# x 12#) 0xe0## x2 = toContinuation (uncheckedShiftRL# x 6#) x3 = toContinuation x Vec.builderAppend (W8# x1) >> Vec.builderAppend (W8# x2) >> Vec.builderAppend (W8# 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# x1) >> Vec.builderAppend (W8# x2) >> Vec.builderAppend (W8# x3) >> Vec.builderAppend (W8# 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: -- -- [ '-' ] [ '.' ] [ ( 'e' | 'E' ) [ '-' ] ] -- -- 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-0.0.11/Basement/String/Builder.hs0000644000000000000000000000304113506061452016503 0ustar0000000000000000-- | -- 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-0.0.11/Basement/NonEmpty.hs0000644000000000000000000000123613506061452015424 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Sized/Block.hs0000644000000000000000000002242013506061452015761 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Sized/UVect.hs0000644000000000000000000001216213506061452015757 0ustar0000000000000000{-# 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-0.0.11/Basement/Sized/Vect.hs0000644000000000000000000001123613506061452015633 0ustar0000000000000000{-# 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-0.0.11/Basement/Sized/List.hs0000644000000000000000000003305113506061452015644 0ustar0000000000000000-- | -- Module : Basement.Sized.List -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/BlockN.hs0000644000000000000000000000032213506061452015016 0ustar0000000000000000-- | -- 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-0.0.11/Basement/NormalForm.hs0000644000000000000000000001225313506061452015730 0ustar0000000000000000module 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-0.0.11/Basement/These.hs0000644000000000000000000000166713506061452014733 0ustar0000000000000000-- | -- Module : Basement.These -- License : BSD-style -- Maintainer : Nicolas Di Prima -- 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-0.0.11/Basement/Terminal.hs0000644000000000000000000000143113506061452015423 0ustar0000000000000000{-# 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-0.0.11/Basement/Terminal/ANSI.hs0000644000000000000000000001113513506061452016157 0ustar0000000000000000-- | -- Module : Basement.Terminal.ANSI -- License : BSD-style -- Maintainer : Vincent Hanquez -- -- 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-0.0.11/Basement/IntegralConv.hs0000644000000000000000000002057513506061452016255 0ustar0000000000000000{-# 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 import GHC.Int import GHC.Word import Prelude (Integer, fromIntegral) import Basement.Compat.Base import Basement.Compat.Natural 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# i instance IntegralUpsize Int8 Int32 where integralUpsize (I8# i) = I32# i instance IntegralUpsize Int8 Int64 where integralUpsize (I8# i) = intToInt64 (I# i) instance IntegralUpsize Int8 Int where integralUpsize (I8# i) = I# i instance IntegralUpsize Int16 Int32 where integralUpsize (I16# i) = I32# i instance IntegralUpsize Int16 Int64 where integralUpsize (I16# i) = intToInt64 (I# i) instance IntegralUpsize Int16 Int where integralUpsize (I16# i) = I# i instance IntegralUpsize Int32 Int64 where integralUpsize (I32# i) = intToInt64 (I# i) instance IntegralUpsize Int32 Int where integralUpsize (I32# i) = I# i instance IntegralUpsize Int Int64 where integralUpsize = intToInt64 instance IntegralUpsize Word8 Word16 where integralUpsize (W8# i) = W16# i instance IntegralUpsize Word8 Word32 where integralUpsize (W8# i) = W32# i instance IntegralUpsize Word8 Word64 where integralUpsize (W8# i) = wordToWord64 (W# i) instance IntegralUpsize Word8 Word where integralUpsize (W8# i) = W# i instance IntegralUpsize Word8 Int16 where integralUpsize (W8# w) = I16# (word2Int# w) instance IntegralUpsize Word8 Int32 where integralUpsize (W8# w) = I32# (word2Int# w) instance IntegralUpsize Word8 Int64 where integralUpsize (W8# w) = intToInt64 (I# (word2Int# w)) instance IntegralUpsize Word8 Int where integralUpsize (W8# w) = I# (word2Int# w) instance IntegralUpsize Word16 Word32 where integralUpsize (W16# i) = W32# i instance IntegralUpsize Word16 Word64 where integralUpsize (W16# i) = wordToWord64 (W# i) instance IntegralUpsize Word16 Word where integralUpsize (W16# i) = W# i instance IntegralUpsize Word32 Word64 where integralUpsize (W32# i) = wordToWord64 (W# i) instance IntegralUpsize Word32 Word where integralUpsize (W32# i) = W# i instance IntegralUpsize Word Word64 where integralUpsize = wordToWord64 instance IntegralDownsize Int Int8 where integralDownsize (I# i) = I8# (narrow8Int# i) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Int Int16 where integralDownsize (I# i) = I16# (narrow16Int# i) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Int Int32 where integralDownsize (I# i) = I32# (narrow32Int# 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# (narrow8Word# (word64ToWord# i)) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word16 where integralDownsize (W64# i) = W16# (narrow16Word# (word64ToWord# i)) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word32 where integralDownsize (W64# i) = W32# (narrow32Word# (word64ToWord# i)) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word8 where integralDownsize (W# w) = W8# (narrow8Word# w) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word16 where integralDownsize (W# w) = W16# (narrow16Word# w) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word32 where integralDownsize (W# w) = W32# (narrow32Word# w) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word32 Word8 where integralDownsize (W32# i) = W8# (narrow8Word# i) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word32 Word16 where integralDownsize (W32# i) = W16# (narrow16Word# i) integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word16 Word8 where integralDownsize (W16# i) = W8# (narrow8Word# 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-0.0.11/Basement/Floating.hs0000644000000000000000000000452313506061452015420 0ustar0000000000000000{-# 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-0.0.11/Basement/Numerical/Number.hs0000644000000000000000000000773613506061452017035 0ustar0000000000000000{-# 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-0.0.11/Basement/Numerical/Additive.hs0000644000000000000000000001413713506061452017327 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# 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.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# (narrow8Int# (a +# b)) scale = scaleNum instance Additive Int16 where azero = 0 (I16# a) + (I16# b) = I16# (narrow16Int# (a +# b)) scale = scaleNum instance Additive Int32 where azero = 0 (I32# a) + (I32# b) = I32# (narrow32Int# (a +# 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# (narrow8Word# (a `plusWord#` b)) scale = scaleNum instance Additive Word16 where azero = 0 (W16# a) + (W16# b) = W16# (narrow16Word# (a `plusWord#` b)) scale = scaleNum instance Additive Word32 where azero = 0 (W32# a) + (W32# b) = W32# (narrow32Word# (a `plusWord#` 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 (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-0.0.11/Basement/Numerical/Subtractive.hs0000644000000000000000000001263613506061452020073 0ustar0000000000000000{-# 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-0.0.11/Basement/Numerical/Multiplicative.hs0000644000000000000000000002063713506061452020573 0ustar0000000000000000{-# 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-0.0.11/Basement/Bounded.hs0000644000000000000000000001042613506061452015234 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Alg/XorShift.hs0000644000000000000000000000400413506061452016120 0ustar0000000000000000-- | -- Module : Foundation.Random.XorShift -- License : BSD-style -- -- XorShift variant: Xoroshiro128+ -- -- -- Xoroshiro128+ is a PRNG that uses a shift/rotate-based linear transformation. -- This is lar -- -- C implementation at: -- -- 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-0.0.11/Basement/Compat/AMP.hs0000644000000000000000000000043413506122561015511 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/Base.hs0000644000000000000000000000525613506061452015756 0ustar0000000000000000-- | -- Module : Basement.Compat.Base -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Compat/Bifunctor.hs0000644000000000000000000000577713506061452017047 0ustar0000000000000000-- | -- Module : Basement.Compat.Bifunctor -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Compat/CallStack.hs0000644000000000000000000000063513506061452016741 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/C/Types.hs0000644000000000000000000000136613506061452016370 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/ExtList.hs0000644000000000000000000000173313506061452016474 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/IsList.hs0000644000000000000000000000126513506061452016307 0ustar0000000000000000-- | -- Module : Basement.Compat.IsList -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Compat/Identity.hs0000644000000000000000000000151713506061452016671 0ustar0000000000000000-- | -- Module : Basement.Compat.Identity -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Compat/Primitive.hs0000644000000000000000000000446313506122747017060 0ustar0000000000000000-- | -- Module : Basement.Compat.Primitive -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : portable -- {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE CPP #-} {-# LANGUAGE UnliftedFFITypes #-} module Basement.Compat.Primitive ( bool# , PinnedStatus(..), toPinnedStatus# , compatMkWeak# , compatIsByteArrayPinned# , compatIsMutableByteArrayPinned# , Word(..) ) where import qualified Prelude import GHC.Exts import GHC.Prim import GHC.Word import GHC.IO import Basement.Compat.PrimTypes -- GHC 8.8 | Base 4.13 -- 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-0.0.11/Basement/Compat/PrimTypes.hs0000644000000000000000000000136313506061452017033 0ustar0000000000000000-- | -- Module : Basement.Compat.PrimTypes -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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-0.0.11/Basement/Compat/MonadTrans.hs0000644000000000000000000000304013506061452017137 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Compat/Semigroup.hs0000644000000000000000000001166513506061452017057 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/Natural.hs0000644000000000000000000000327013506061452016504 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/NumLiteral.hs0000644000000000000000000001356613506061452017163 0ustar0000000000000000{-# 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-0.0.11/Basement/Compat/Typeable.hs0000644000000000000000000000146413506061452016646 0ustar0000000000000000-- | -- Module : Basement.Compat.Typeable -- License : BSD-style -- Maintainer : Nicolas Di Prima -- 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-0.0.11/Basement/Bits.hs0000644000000000000000000006226013506061452014560 0ustar0000000000000000-- | -- 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 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# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (8# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 7##) rotateR (W8# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W8# x# | otherwise = W8# (narrow8Word# ((x# `uncheckedShiftRL#` i'#) `or#` (x# `uncheckedShiftL#` (8# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 7##) bitFlip (W8# x#) = W8# (x# `xor#` mb#) where !(W8# mb#) = maxBound popCount (W8# x#) = CountOf $ wordToInt (W# (popCnt8# x#)) countLeadingZeros (W8# w#) = CountOf $ wordToInt (W# (clz8# w#)) countTrailingZeros (W8# w#) = CountOf $ wordToInt (W# (ctz8# w#)) instance BitOps Word8 where (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#) (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#) (W8# x#) .^. (W8# y#) = W8# (x# `xor#` y#) (W8# x#) .<<. (CountOf (I# i#)) = W8# (narrow8Word# (x# `shiftL#` i#)) (W8# x#) .>>. (CountOf (I# i#)) = W8# (narrow8Word# (x# `shiftRL#` i#)) -- Word16 --------------------------------------------------------------------- instance FiniteBitsOps Word16 where numberOfBits _ = 16 rotateL (W16# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W16# x# | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (16# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 15##) rotateR (W16# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W16# x# | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftRL#` i'#) `or#` (x# `uncheckedShiftL#` (16# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 15##) bitFlip (W16# x#) = W16# (x# `xor#` mb#) where !(W16# mb#) = maxBound popCount (W16# x#) = CountOf $ wordToInt (W# (popCnt16# x#)) countLeadingZeros (W16# w#) = CountOf $ wordToInt (W# (clz16# w#)) countTrailingZeros (W16# w#) = CountOf $ wordToInt (W# (ctz16# w#)) instance BitOps Word16 where (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#) (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#) (W16# x#) .^. (W16# y#) = W16# (x# `xor#` y#) (W16# x#) .<<. (CountOf (I# i#)) = W16# (narrow16Word# (x# `shiftL#` i#)) (W16# x#) .>>. (CountOf (I# i#)) = W16# (narrow16Word# (x# `shiftRL#` i#)) -- Word32 --------------------------------------------------------------------- instance FiniteBitsOps Word32 where numberOfBits _ = 32 rotateL (W32# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W32# x# | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (32# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 31##) rotateR (W32# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = W32# x# | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftRL#` i'#) `or#` (x# `uncheckedShiftL#` (32# -# i'#)))) where !i'# = word2Int# (int2Word# i# `and#` 31##) bitFlip (W32# x#) = W32# (x# `xor#` mb#) where !(W32# mb#) = maxBound popCount (W32# x#) = CountOf $ wordToInt (W# (popCnt32# x#)) countLeadingZeros (W32# w#) = CountOf $ wordToInt (W# (clz32# w#)) countTrailingZeros (W32# w#) = CountOf $ wordToInt (W# (ctz32# w#)) instance BitOps Word32 where (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#) (W32# x#) .^. (W32# y#) = W32# (x# `xor#` y#) (W32# x#) .<<. (CountOf (I# i#)) = W32# (narrow32Word# (x# `shiftL#` i#)) (W32# x#) .>>. (CountOf (I# i#)) = W32# (narrow32Word# (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# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (8# -# i'#))))) where !x'# = narrow8Word# (int2Word# x#) !i'# = word2Int# (int2Word# i# `and#` 7##) rotateR (I8# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I8# x# | otherwise = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#` (x'# `uncheckedShiftL#` (8# -# i'#))))) where !x'# = narrow8Word# (int2Word# x#) !i'# = word2Int# (int2Word# i# `and#` 7##) bitFlip (I8# x#) = I8# (word2Int# (not# (int2Word# x#))) popCount (I8# x#) = CountOf $ wordToInt (W# (popCnt8# (int2Word# x#))) countLeadingZeros (I8# w#) = CountOf $ wordToInt (W# (clz8# (int2Word# w#))) countTrailingZeros (I8# w#) = CountOf $ wordToInt (W# (ctz8# (int2Word# w#))) instance BitOps Int8 where (I8# x#) .&. (I8# y#) = I8# (x# `andI#` y#) (I8# x#) .|. (I8# y#) = I8# (x# `orI#` y#) (I8# x#) .^. (I8# y#) = I8# (x# `xorI#` y#) (I8# x#) .<<. (CountOf (I# i#)) = I8# (narrow8Int# (x# `iShiftL#` i#)) (I8# x#) .>>. (CountOf (I# i#)) = I8# (narrow8Int# (x# `iShiftRL#` i#)) -- Int16 ---------------------------------------------------------------------- instance FiniteBitsOps Int16 where numberOfBits _ = 16 rotateL (I16# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I16# x# | otherwise = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (16# -# i'#))))) where !x'# = narrow16Word# (int2Word# x#) !i'# = word2Int# (int2Word# i# `and#` 15##) rotateR (I16# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I16# x# | otherwise = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#` (x'# `uncheckedShiftL#` (16# -# i'#))))) where !x'# = narrow16Word# (int2Word# x#) !i'# = word2Int# (int2Word# i# `and#` 15##) bitFlip (I16# x#) = I16# (word2Int# (not# (int2Word# x#))) popCount (I16# x#) = CountOf $ wordToInt (W# (popCnt16# (int2Word# x#))) countLeadingZeros (I16# w#) = CountOf $ wordToInt (W# (clz16# (int2Word# w#))) countTrailingZeros (I16# w#) = CountOf $ wordToInt (W# (ctz16# (int2Word# w#))) instance BitOps Int16 where (I16# x#) .&. (I16# y#) = I16# (x# `andI#` y#) (I16# x#) .|. (I16# y#) = I16# (x# `orI#` y#) (I16# x#) .^. (I16# y#) = I16# (x# `xorI#` y#) (I16# x#) .<<. (CountOf (I# i#)) = I16# (narrow16Int# (x# `iShiftL#` i#)) (I16# x#) .>>. (CountOf (I# i#)) = I16# (narrow16Int# (x# `iShiftRL#` i#)) -- Int32 ---------------------------------------------------------------------- instance FiniteBitsOps Int32 where numberOfBits _ = 32 rotateL (I32# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I32# x# | otherwise = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (32# -# i'#))))) where !x'# = narrow32Word# (int2Word# x#) !i'# = word2Int# (int2Word# i# `and#` 31##) rotateR (I32# x#) (CountOf (I# i#)) | isTrue# (i'# ==# 0#) = I32# x# | otherwise = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#` (x'# `uncheckedShiftL#` (32# -# i'#))))) where !x'# = narrow32Word# (int2Word# x#) !i'# = word2Int# (int2Word# i# `and#` 31##) bitFlip (I32# x#) = I32# (word2Int# (not# (int2Word# x#))) popCount (I32# x#) = CountOf $ wordToInt (W# (popCnt32# (int2Word# x#))) countLeadingZeros (I32# w#) = CountOf $ wordToInt (W# (clz32# (int2Word# w#))) countTrailingZeros (I32# w#) = CountOf $ wordToInt (W# (ctz32# (int2Word# w#))) instance BitOps Int32 where (I32# x#) .&. (I32# y#) = I32# (x# `andI#` y#) (I32# x#) .|. (I32# y#) = I32# (x# `orI#` y#) (I32# x#) .^. (I32# y#) = I32# (x# `xorI#` y#) (I32# x#) .<<. (CountOf (I# i#)) = I32# (narrow32Int# (x# `iShiftL#` i#)) (I32# x#) .>>. (CountOf (I# i#)) = I32# (narrow32Int# (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-0.0.11/Basement/Error.hs0000644000000000000000000000175713506061452014754 0ustar0000000000000000{-# 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-0.0.11/Basement/Show.hs0000644000000000000000000000060213506061452014567 0ustar0000000000000000module 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-0.0.11/Basement/Runtime.hs0000644000000000000000000000223413506061452015275 0ustar0000000000000000-- | -- 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-0.0.11/Basement/Alg/Class.hs0000644000000000000000000000064013506061452015421 0ustar0000000000000000{-# 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-0.0.11/Basement/Alg/Mutable.hs0000644000000000000000000000604713506061452015754 0ustar0000000000000000{-# 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] -- 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 (i==j OR aj=p AND aj= 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-0.0.11/Basement/Alg/PrimArray.hs0000644000000000000000000001006413506061452016263 0ustar0000000000000000{-# 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-0.0.11/Basement/Alg/UTF8.hs0000644000000000000000000002571413506061452015113 0ustar0000000000000000{-# 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 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# v1 -> atLeast2 (maskContinuation# v1) | otherwise -> StepBack (toChar# 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# v2 -> atLeast3 (or# (uncheckedShiftL# (maskContinuation# v2) 6#) v) | otherwise -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader2# v2) 6#) v)) prevOfs2 atLeast3 !v = case index ba prevOfs3 of (W8# v3) | isContinuation# v3 -> atLeast4 (or# (uncheckedShiftL# (maskContinuation# v3) 12#) v) | otherwise -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader3# v3) 12#) v)) prevOfs3 atLeast4 !v = case index ba prevOfs4 of (W8# v4) -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader4# 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# x) >> pure (i + Offset 1) encode2 = do let x1 = or# (uncheckedShiftRL# x 6#) 0xc0## x2 = toContinuation x write mba i (W8# x1) write mba (i+1) (W8# 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# x1) write mba (i+Offset 1) (W8# x2) write mba (i+Offset 2) (W8# 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# x1) write mba (i+Offset 1) (W8# x2) write mba (i+Offset 2) (W8# x3) write mba (i+Offset 3) (W8# 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-0.0.11/Basement/Alg/String.hs0000644000000000000000000001156213506061452015627 0ustar0000000000000000{-# 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-0.0.11/Basement/Numerical/Conversion.hs0000644000000000000000000000430313506061452017715 0ustar0000000000000000{-# 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 GHC.Types import GHC.Prim 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# (uncheckedShiftRL# w64 32#)) (W32# (narrow32Word# 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-0.0.11/Basement/Block/Base.hs0000644000000000000000000004535513506061452015571 0ustar0000000000000000{-# 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-0.0.11/Basement/UTF8/Base.hs0000644000000000000000000002147513506061452015262 0ustar0000000000000000-- | -- 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-0.0.11/Basement/UTF8/Helper.hs0000644000000000000000000002136713506061452015627 0ustar0000000000000000-- | -- 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.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# w toChar2 :: StepASCII -> Word8 -> Char toChar2 (StepASCII (W8# w1)) (W8# w2) = toChar# (or# (uncheckedShiftL# (maskHeader2# w1) 6#) (maskContinuation# w2)) toChar3 :: StepASCII -> Word8 -> Word8 -> Char toChar3 (StepASCII (W8# w1)) (W8# w2) (W8# w3) = toChar# (or3# (uncheckedShiftL# (maskHeader3# w1) 12#) (uncheckedShiftL# (maskContinuation# w2) 6#) (maskContinuation# w3) ) toChar4 :: StepASCII -> Word8 -> Word8 -> Word8 -> Char toChar4 (StepASCII (W8# w1)) (W8# w2) (W8# w3) (W8# w4) = toChar# (or4# (uncheckedShiftL# (maskHeader4# w1) 18#) (uncheckedShiftL# (maskContinuation# w2) 12#) (uncheckedShiftL# (maskContinuation# w3) 6#) (maskContinuation# 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# x) encode2 = let !x1 = W8# (or# (uncheckedShiftRL# x 6#) 0xc0##) !x2 = toContinuation x in UTF8_2 x1 x2 encode3 = let !x1 = W8# (or# (uncheckedShiftRL# x 12#) 0xe0##) !x2 = toContinuation (uncheckedShiftRL# x 6#) !x3 = toContinuation x in UTF8_3 x1 x2 x3 encode4 = let !x1 = W8# (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# (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# 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# (and# mask2 (or3# set2 (uncheckedShiftRL# x 6#) -- 5 bits to 1st byte (uncheckedShiftL# x 8# ) -- move lowest bits to the 2nd byte )) encode3 = W32# (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# (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# w | isCharUTF8Case2 c = encode2 | isCharUTF8Case3 c = encode3 | otherwise = encode4 where encode2 = toChar# (or# (uncheckedShiftL# (maskHeader2# w) 6#) (maskContinuation# (uncheckedShiftRL# w 8#)) ) encode3 = toChar# (or3# (uncheckedShiftL# (maskHeader3# w) 12#) (uncheckedShiftRL# (and# 0x3f00## w) 8#) (maskContinuation# (uncheckedShiftRL# w 16#)) ) encode4 = toChar# (or4# (uncheckedShiftL# (maskHeader4# w) 18#) (uncheckedShiftRL# (and# 0x3f00## w) 10#) (uncheckedShiftL# (and# 0x3f0000## w) 4#) (maskContinuation# (uncheckedShiftRL# 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# w 0x80##) 0##) {-# INLINE isCharUTF8Case1 #-} isCharUTF8Case2 :: CharUTF8 -> Bool isCharUTF8Case2 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x20##) 0##) {-# INLINE isCharUTF8Case2 #-} isCharUTF8Case3 :: CharUTF8 -> Bool isCharUTF8Case3 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x10##) 0##) {-# INLINE isCharUTF8Case3 #-} isCharUTF8Case4 :: CharUTF8 -> Bool isCharUTF8Case4 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x08##) 0##) {-# INLINE isCharUTF8Case4 #-} basement-0.0.11/Basement/UTF8/Table.hs0000644000000000000000000001135713506061452015435 0ustar0000000000000000-- | -- Module : Basement.UTF8.Table -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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.UTF8.Types (StepASCII(..)) -- | Check if the byte is a continuation byte isContinuation :: Word8 -> Bool isContinuation (W8# w) = isContinuation# w {-# INLINE isContinuation #-} isContinuation2 :: Word8 -> Word8 -> Bool isContinuation2 (W8# w1) (W8# w2) = bool# (mask w1 `andI#` mask 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 w1) && bool# (mask w2) && bool# (mask 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# w) {-# INLINE getNbBytes #-} -- | Check if the byte is a continuation byte isContinuation# :: Word# -> Bool isContinuation# w = W# (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# (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-0.0.11/Basement/UTF8/Types.hs0000644000000000000000000000431113506061452015502 0ustar0000000000000000module 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 basement-0.0.11/Basement/UArray/Base.hs0000644000000000000000000006102013506061452015725 0ustar0000000000000000{-# 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.Prim 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-0.0.11/Basement/String/CaseMapping.hs0000644000000000000000000041622713506061452017322 0ustar0000000000000000{-# 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-0.0.11/Basement/String/Encoding/Encoding.hs0000644000000000000000000000716313506061452020402 0ustar0000000000000000-- | -- 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-0.0.11/Basement/String/Encoding/UTF16.hs0000644000000000000000000000573313506061452017462 0ustar0000000000000000-- | -- 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.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 hh, off + Offset 1) | h >= 0xe000 = Right (toChar 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# w nextContinuation | cont >= 0xdc00 && cont < 0xe00 = let !(W32# w) = ((to32 h .&. 0x3ff) `shiftL` 10) .|. (to32 cont .&. 0x3ff) in Right (toChar 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# (int2Word# (ord# ch)) to16 :: Word32 -> Word16 to16 = Prelude.fromIntegral wHigh :: Char -> (Word16, Word16) wHigh (C# ch) = let v = W32# (minusWord# (int2Word# (ord# ch)) 0x10000##) in (0xdc00 .|. to16 (v `shiftR` 10), 0xd800 .|. to16 (v .&. 0x3ff)) basement-0.0.11/Basement/String/Encoding/UTF32.hs0000644000000000000000000000250213506061452017447 0ustar0000000000000000-- | -- 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.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# 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# (int2Word# (ord# ch)) basement-0.0.11/Basement/String/Encoding/ASCII7.hs0000644000000000000000000000432213506061452017565 0ustar0000000000000000-- | -- 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 -- | 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# (and# 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 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# (int2Word# (ord# ch)) basement-0.0.11/Basement/String/Encoding/ISO_8859_1.hs0000644000000000000000000000276713506061452020230 0ustar0000000000000000-- | -- 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 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 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# x) | otherwise = throw $ NotISO_8859_1 c where x :: Word# !x = int2Word# (ord# ch) basement-0.0.11/Basement/Terminal/Size.hsc0000644000000000000000000001426213506061452016506 0ustar0000000000000000{-# 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 #elif defined FOUNDATION_SYSTEM_UNIX #include #ifdef __sun #include #endif #endif #include #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-0.0.11/cbits/foundation_mem.c0000644000000000000000000000065613506061452016042 0ustar0000000000000000#include #include #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); } basement-0.0.11/cbits/basement_rts.c0000644000000000000000000000022713506061452015516 0ustar0000000000000000#include "Rts.h" #if __GLASGOW_HASKELL__ < 802 int basement_is_bytearray_pinned(void *p) { return Bdescr((StgPtr) p)->flags & BF_PINNED; } #endif basement-0.0.11/LICENSE0000644000000000000000000000300613506061452012563 0ustar0000000000000000Copyright (c) 2015-2017 Vincent Hanquez 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. basement-0.0.11/Setup.hs0000644000000000000000000000005613506061452013214 0ustar0000000000000000import Distribution.Simple main = defaultMain basement-0.0.11/basement.cabal0000644000000000000000000001255713512641224014351 0ustar0000000000000000name: basement version: 0.0.11 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 , 2017-2018 Foundation Maintainers maintainer: vincent@snarc.org category: Web build-type: Simple homepage: https://github.com/haskell-foundation/foundation#readme bug-reports: https://github.com/haskell-foundation/foundation/issues cabal-version: 1.18 extra-source-files: cbits/*.h cbits/basement_rts.c source-repository head type: git location: https://github.com/haskell-foundation/foundation 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 -- support and dependencies if impl(ghc < 8.0) buildable: False else build-depends: base , 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 basement-0.0.11/cbits/foundation_prim.h0000644000000000000000000000020113506061452016222 0ustar0000000000000000#ifndef FOUNDATION_PRIM_H #define FOUNDATION_PRIM_H #include "Rts.h" typedef StgInt FsOffset; typedef StgInt FsCountOf; #endif basement-0.0.11/cbits/foundation_system.h0000644000000000000000000000320313506061452016604 0ustar0000000000000000#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