{- LIQUID "--no-pattern-inline" @-} {-# LANGUAGE CPP, MagicHash #-} -- | -- Module : Data.Text.UnsafeChar -- Copyright : (c) 2008, 2009 Tom Harper, -- (c) 2009, 2010 Bryan O'Sullivan, -- (c) 2009 Duncan Coutts -- -- License : BSD-style -- Maintainer : bos@serpentine.com, rtomharper@googlemail.com, -- duncan@haskell.org -- Stability : experimental -- Portability : GHC -- -- Fast character manipulation functions. module Data.Text.UnsafeChar ( ord , unsafeChr , unsafeChr8 , unsafeChr32 , unsafeWrite -- , unsafeWriteRev ) where #ifdef ASSERTS import Control.Exception (assert) #endif import Control.Monad.ST (ST) import Data.Bits ((.&.)) import Data.Text.UnsafeShift (shiftR) import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#) import GHC.Word (Word8(..), Word16(..), Word32(..)) import qualified Data.Text.Array as A --LIQUID import Language.Haskell.Liquid.Prelude {-@ measure ordP :: Char -> Int @-} {-@ predicate One C = ((ordP C) < 65536) @-} {-@ predicate Two C = ((ordP C) >= 65536) @-} {-@ qualOneC :: {v:Char | (ordP v) < 65536} -> () @-} qualOneC :: Char -> () qualOneC _ = () {-@ qualTwoC :: {v:Char | (ordP v) >= 65536} -> () @-} qualTwoC :: Char -> () qualTwoC _ = () {-@ predicate Room MA I C = (((One C) => (MAValidIN MA I 1)) && ((Two C) => (MAValidIN MA I 2))) @-} {-@ predicate MAValidIN MA I N = (BtwnI I 0 ((maLen MA) - N)) @-} {- predicate RoomFront MA I N = (BtwnI I N (malen MA)) @-} {-@ ord :: c:Char -> {v:Int | v = (ordP c)} @-} ord :: Char -> Int ord c@(C# c#) = let i = I# (ord# c#) in liquidAssume (axiom_ord c i) i {-@ axiom_ord :: c:Char -> i:Int -> {v:Bool | (v <=> (i = (ordP c)))} @-} axiom_ord :: Char -> Int -> Bool axiom_ord = undefined {-# INLINE ord #-} unsafeChr :: Word16 -> Char unsafeChr (W16# w#) = C# (chr# (word2Int# w#)) {-# INLINE unsafeChr #-} unsafeChr8 :: Word8 -> Char unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#)) {-# INLINE unsafeChr8 #-} unsafeChr32 :: Word32 -> Char unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#)) {-# INLINE unsafeChr32 #-} -- | Write a character into the array at the given offset. Returns -- the number of 'Word16's written. {-@ unsafeWrite :: ma:A.MArray s -> i:Nat -> {v:Char | (Room ma i v)} -> ST s {v:(MAValidL i ma) | (BtwnI v 1 2)} @-} unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int unsafeWrite marr i c | n < 0x10000 = do -- #if defined(ASSERTS) liquidAssert (i >= 0) . liquidAssert (i < A.maLen marr) $ return () -- #endif A.unsafeWrite marr i (fromIntegral n) return 1 | otherwise = do -- #if defined(ASSERTS) liquidAssert (i >= 0) . liquidAssert (i < A.maLen marr - 1) $ return () -- #endif A.unsafeWrite marr i lo A.unsafeWrite marr (i+1) hi return 2 where n = ord c m = n - 0x10000 lo = fromIntegral $ (m `shiftR` 10) + 0xD800 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00 {-# INLINE unsafeWrite #-} {- unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int unsafeWriteRev marr i c | n < 0x10000 = do assert (i >= 0) . assert (i < A.length marr) $ A.unsafeWrite marr i (fromIntegral n) return (i-1) | otherwise = do assert (i >= 1) . assert (i < A.length marr) $ A.unsafeWrite marr (i-1) lo A.unsafeWrite marr i hi return (i-2) where n = ord c m = n - 0x10000 lo = fromIntegral $ (m `shiftR` 10) + 0xD800 hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00 {-# INLINE unsafeWriteRev #-} -}