diff --git a/ucd2haskell/exe/UCD2Haskell/Generator.hs b/ucd2haskell/exe/UCD2Haskell/Generator.hs index b3eac91..8e550fe 100644 --- a/ucd2haskell/exe/UCD2Haskell/Generator.hs +++ b/ucd2haskell/exe/UCD2Haskell/Generator.hs @@ -20,6 +20,7 @@ module UCD2Haskell.Generator , chunkAddrLiteral , word32ToWord8s , splitPlanes + , ShamochuCode(..) , genBitmapShamochu , genEnumBitmapShamochu , generateShamochuBitmaps @@ -29,20 +30,26 @@ module UCD2Haskell.Generator , unlinesBB , unwordsBB , apacheLicense + , mkImports + , (<+>) + , mkImports' ) where import Control.Exception (assert) -import Data.Bifunctor (Bifunctor(..)) +import Data.Bifunctor (Bifunctor (..)) import Data.Bits (Bits (..)) import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL -import Data.Char (toUpper) +import qualified Data.ByteString.Short as BS +import Data.Char (chr, isAlpha, toUpper) import Data.Fixed (Centi) import qualified Data.List as L import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe) import Data.Ratio ((%)) +import qualified Data.Set as Set +import Data.String (IsString (..)) import Data.Version (Version, showVersion) import Data.Word (Word32, Word8) import Debug.Trace (trace) @@ -61,6 +68,7 @@ import UCD2Haskell.Common ( showB, showPaddedHeXB, ) +import qualified Data.Map.Strict as Map -------------------------------------------------------------------------------- -- Recipe @@ -466,15 +474,25 @@ genBitmapShamochu :: -> [Word] -- ^ Chunk size stage 2 -> [Int] - -> BB.Builder -genBitmapShamochu funcNameStr stage1 stage2 ordList = mconcat - [ "{-# INLINE " <> funcName <> " #-}\n" - , funcName, " :: Char -> Bool\n" - , funcName, func - , "\n" - , generateShamochuBitmaps funcNameStr False BitMap stage1 stage2 id (packBits bitmap) - ] + -> ShamochuCode +genBitmapShamochu funcNameStr stage1 stage2 ordList = ShamochuCode + { code = mconcat + [ "{-# INLINE " <> funcName <> " #-}\n" + , funcName, " :: Char -> Bool\n" + , funcName, func + , "\n" + , code + ] + , imports = imports } where + ShamochuCode{..} = generateShamochuBitmaps + funcNameStr + False + BitMap + stage1 + stage2 + id + (packBits bitmap) funcName = BB.string7 funcNameStr rawBitmap = positionsToBitMap ordList lookupFunc = toLookupBitMapName funcNameStr @@ -555,16 +573,26 @@ genEnumBitmapShamochu -- ^ List of values to encode for planes 0 to 3 -> [a] -- ^ List of values to encode for plane 14 - -> BB.Builder + -> ShamochuCode genEnumBitmapShamochu funcNameStr rawInt stage1 stage2 convert (defPUA, pPUA) (def, pDef) planes0To3 plane14 = - mconcat - [ "{-# INLINE ", funcName, " #-}\n" - , funcName, " :: Char -> Int", rawSuffix, "\n" - , funcName, func - , "\n" - , generateShamochuBitmaps funcNameStr rawInt ByteMap stage1 stage2 convert bitmap - ] + ShamochuCode + { code = mconcat + [ "{-# INLINE ", funcName, " #-}\n" + , funcName, " :: Char -> Int", rawSuffix, "\n" + , funcName, func + , "\n" + , code + ] + , imports = imports } where + ShamochuCode{..} = generateShamochuBitmaps + funcNameStr + rawInt + ByteMap + stage1 + stage2 + convert + bitmap rawSuffix = if rawInt then "#" else "" funcName = BB.string7 funcNameStr lookupFunc = toLookupBitMapName funcNameStr @@ -618,6 +646,19 @@ genEnumBitmapShamochu funcNameStr rawInt stage1 stage2 convert (defPUA, pPUA) (d , planes0To3' <> plane14' ) data BitmapType = BitMap | ByteMap +type Imports = Map.Map BS.ShortByteString (Set.Set BS.ShortByteString) + +data ShamochuCode = ShamochuCode + { code :: !BB.Builder + , imports :: !Imports } + +instance Semigroup ShamochuCode where + ShamochuCode c1 i1 <> ShamochuCode c2 i2 = + ShamochuCode (c1 <> "\n" <> c2) (i1 <+> i2) + +instance Monoid ShamochuCode where + mempty = ShamochuCode mempty mempty + generateShamochuBitmaps :: -- | Name of the function String -> @@ -633,122 +674,161 @@ generateShamochuBitmaps :: (a -> Word8) -> -- | Input [a] -> - BB.Builder + -- | Bitmaps Haskell code and list of + ShamochuCode generateShamochuBitmaps name rawInt mapType powersStage1 powersStage2 convert xs = case Shamochu.compress powersStage1 powersStage2 xs' of - Shamochu.OneStage{..} -> trace' "OneStage" stats $ mconcat - [ "{-# INLINE ", toLookupBitMapName name, " #-}\n" - , toLookupBitMapName name, " :: Int", rawSuffix, " -> ", outputType, "\n" - , toLookupBitMapName name, " n =\n" - -- Lookup: - -- mask = (1 << chunk_size_log2) - 1; - -- original[i] = data[offsets[i >> chunk_size_log2] + (i & mask)]; - , case mapType of - BitMap -> mkBitLookup "data" 1 . mconcat $ - [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets" 2 $ - mkIndent 3 <> mkShiftR "n" (3 + Shamochu.dataChunkSizeLog2 stats) - , mkAnd (mkShiftR' "n" 3) "mask" ] - ByteMap -> mkWordLookup (Shamochu.dataIntSize stats) "data" 1 . mconcat $ - [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets" 2 $ - mkIndent 3 <> mkShiftR "n" (Shamochu.dataChunkSizeLog2 stats) - , mkAnd "n" "mask" ] - , "\n" - , " where\n" - , " ", mkMaskDef "mask" (Shamochu.dataChunkSizeLog2 stats) - , " !(Ptr data#) = ", dataBitMap, "\n" - , " !(Ptr offsets#) = ", offsetsBitMap, "\n" - , "\n" - , dataBitMap, " :: Ptr ", dataType, "\n" - , dataBitMap, " = Ptr\n" - , " \"", enumMapToAddrLiteral' - 4 - 50 - (Shamochu.dataIntSize stats `shiftR` 3) - (pad (Exts.toList array)) - "\"#\n" - , "\n" - , offsetsBitMap, " :: Ptr ", offsetType, "\n" - , offsetsBitMap, " = Ptr\n" - , " \"", enumMapToAddrLiteral' - 4 - 50 - (Shamochu.offsets1IntSize stats `shiftR` 3) - (Exts.toList offsets) - "\"#\n" - ] + Shamochu.OneStage{..} -> trace' "OneStage" stats $ ShamochuCode{..} where + code = mconcat + [ "{-# INLINE ", toLookupBitMapName name, " #-}\n" + , toLookupBitMapName name, " :: Int", rawSuffix, " -> ", outputType, "\n" + , toLookupBitMapName name, " n =\n" + -- Lookup: + -- mask = (1 << chunk_size_log2) - 1; + -- original[i] = data[offsets[i >> chunk_size_log2] + (i & mask)]; + , case mapType of + BitMap -> mkBitLookup "data" 1 . mconcat $ + [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets" 2 $ + mkIndent 3 <> mkShiftR "n" (3 + Shamochu.dataChunkSizeLog2 stats) + , mkAnd (mkShiftR' "n" 3) "mask" ] + ByteMap -> mkWordLookup (Shamochu.dataIntSize stats) "data" 1 . mconcat $ + [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets" 2 $ + mkIndent 3 <> mkShiftR "n" (Shamochu.dataChunkSizeLog2 stats) + , mkAnd "n" "mask" ] + , "\n" + , " where\n" + , " ", mkMaskDef "mask" (Shamochu.dataChunkSizeLog2 stats) + , " !(Ptr data#) = ", dataBitMap, "\n" + , " !(Ptr offsets#) = ", offsetsBitMap, "\n" + , "\n" + , dataBitMap, " :: Ptr ", dataType, "\n" + , dataBitMap, " = Ptr\n" + , " \"", enumMapToAddrLiteral' + 4 + 50 + (Shamochu.dataIntSize stats `shiftR` 3) + (pad (Exts.toList array)) + "\"#\n" + , "\n" + , offsetsBitMap, " :: Ptr ", offsetType, "\n" + , offsetsBitMap, " = Ptr\n" + , " \"", enumMapToAddrLiteral' + 4 + 50 + (Shamochu.offsets1IntSize stats `shiftR` 3) + (Exts.toList offsets) + "\"#\n" + ] + imports = case mapType of + BitMap + | rawInt -> error "unsupported" + | otherwise -> defaultBitMapImports + (Shamochu.offsets1IntSize stats) + <+> defaultByteMapImportsBoxed + ByteMap + | rawInt -> defaultByteMapImports + (Shamochu.dataIntSize stats) + (Shamochu.offsets1IntSize stats) + <+> defaultByteMapImportsUnboxed + | otherwise -> defaultByteMapImports + (Shamochu.dataIntSize stats) + (Shamochu.offsets1IntSize stats) + <+> defaultByteMapImportsBoxed Shamochu.CompressedArray{..} = array1 dataBitMap = nameBB <> "DataBitMap" offsetsBitMap = nameBB <> "OffsetsBitMap" dataType = "Int" <> BB.wordDec (Shamochu.dataIntSize stats) offsetType = "Word" <> BB.wordDec (Shamochu.offsets1IntSize stats) - Shamochu.TwoStages{..} -> trace' "TwoStages" stats $ mconcat - [ "{-# INLINE ", toLookupBitMapName name, " #-}\n" - , toLookupBitMapName name, " :: Int", rawSuffix, " -> ", outputType, "\n" - , toLookupBitMapName name, " n =\n" - -- Lookup: - -- mask_data = (1 << data_chunk_size_log2) - 1 - -- mask_offsets = (1 << offsets_chunk_size_log2) - 1 - -- data[ - -- offsets1[ - -- offsets2[i >> (data_chunk_size_log2 + offsets_chunk_size_log2)] + - -- ((i >> data_chunk_size_log2) & mask_offsets) - -- ] + - -- (i & mask_data) - -- ]; - , case mapType of - BitMap -> mkBitLookup "data" 1 . mconcat $ - [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets1" 2 . mconcat $ - [ mkWordLookup (Shamochu.offsets2IntSize stats) "offsets2" 3 $ - mkIndent 4 <> - mkShiftR "n" (3 + Shamochu.dataChunkSizeLog2 stats + Shamochu.offsets1ChunkSizeLog2 stats) - , mkAnd (mkShiftR' "n" (3 + Shamochu.dataChunkSizeLog2 stats)) "maskOffsets" - ] - , mkAnd (mkShiftR' "n" 3) "maskData" ] - ByteMap -> mkWordLookup (Shamochu.dataIntSize stats) "data" 1 . mconcat $ - [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets1" 2 . mconcat $ - [ mkWordLookup (Shamochu.offsets2IntSize stats) "offsets2" 3 $ - mkIndent 4 <> - mkShiftR "n" (Shamochu.dataChunkSizeLog2 stats + Shamochu.offsets1ChunkSizeLog2 stats) - , mkAnd (mkShiftR' "n" (Shamochu.dataChunkSizeLog2 stats)) "maskOffsets" - ] - , mkAnd "n" "maskData" ] - , "\n" - , " where\n" - , " ", mkMaskDef "maskData" (Shamochu.dataChunkSizeLog2 stats) - , " ", mkMaskDef "maskOffsets" (Shamochu.offsets1ChunkSizeLog2 stats) - , " !(Ptr data#) = ", dataBitMap, "\n" - , " !(Ptr offsets1#) = ", offsets1BitMap, "\n" - , " !(Ptr offsets2#) = ", offsets2BitMap, "\n" - , "\n" - , dataBitMap, " :: Ptr ", dataType, "\n" - , dataBitMap, " = Ptr\n" - , " \"", enumMapToAddrLiteral' - 4 - 50 - (Shamochu.dataIntSize stats `shiftR` 3) - (pad (Exts.toList dataArray)) - "\"#\n" - , "\n" - , offsets1BitMap, " :: Ptr ", offset1Type, "\n" - , offsets1BitMap, " = Ptr\n" - , " \"", enumMapToAddrLiteral' - 4 - 50 - (Shamochu.offsets1IntSize stats `shiftR` 3) - (Exts.toList offset1Array) - "\"#\n" - , "\n" - , offsets2BitMap, " :: Ptr ", offset2Type, "\n" - , offsets2BitMap, " = Ptr\n" - , " \"", enumMapToAddrLiteral' - 4 - 50 - (Shamochu.offsets2IntSize stats `shiftR` 3) - (Exts.toList offsets2Array) - "\"#\n" - ] + Shamochu.TwoStages{..} -> trace' "TwoStages" stats $ ShamochuCode{..} where + code = mconcat + [ "{-# INLINE ", toLookupBitMapName name, " #-}\n" + , toLookupBitMapName name, " :: Int", rawSuffix, " -> ", outputType, "\n" + , toLookupBitMapName name, " n =\n" + -- Lookup: + -- mask_data = (1 << data_chunk_size_log2) - 1 + -- mask_offsets = (1 << offsets_chunk_size_log2) - 1 + -- data[ + -- offsets1[ + -- offsets2[i >> (data_chunk_size_log2 + offsets_chunk_size_log2)] + + -- ((i >> data_chunk_size_log2) & mask_offsets) + -- ] + + -- (i & mask_data) + -- ]; + , case mapType of + BitMap -> mkBitLookup "data" 1 . mconcat $ + [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets1" 2 . mconcat $ + [ mkWordLookup (Shamochu.offsets2IntSize stats) "offsets2" 3 $ + mkIndent 4 <> + mkShiftR "n" (3 + Shamochu.dataChunkSizeLog2 stats + Shamochu.offsets1ChunkSizeLog2 stats) + , mkAnd (mkShiftR' "n" (3 + Shamochu.dataChunkSizeLog2 stats)) "maskOffsets" + ] + , mkAnd (mkShiftR' "n" 3) "maskData" ] + ByteMap -> mkWordLookup (Shamochu.dataIntSize stats) "data" 1 . mconcat $ + [ mkWordLookup (Shamochu.offsets1IntSize stats) "offsets1" 2 . mconcat $ + [ mkWordLookup (Shamochu.offsets2IntSize stats) "offsets2" 3 $ + mkIndent 4 <> + mkShiftR "n" (Shamochu.dataChunkSizeLog2 stats + Shamochu.offsets1ChunkSizeLog2 stats) + , mkAnd (mkShiftR' "n" (Shamochu.dataChunkSizeLog2 stats)) "maskOffsets" + ] + , mkAnd "n" "maskData" ] + , "\n" + , " where\n" + , " ", mkMaskDef "maskData" (Shamochu.dataChunkSizeLog2 stats) + , " ", mkMaskDef "maskOffsets" (Shamochu.offsets1ChunkSizeLog2 stats) + , " !(Ptr data#) = ", dataBitMap, "\n" + , " !(Ptr offsets1#) = ", offsets1BitMap, "\n" + , " !(Ptr offsets2#) = ", offsets2BitMap, "\n" + , "\n" + , dataBitMap, " :: Ptr ", dataType, "\n" + , dataBitMap, " = Ptr\n" + , " \"", enumMapToAddrLiteral' + 4 + 50 + (Shamochu.dataIntSize stats `shiftR` 3) + (pad (Exts.toList dataArray)) + "\"#\n" + , "\n" + , offsets1BitMap, " :: Ptr ", offset1Type, "\n" + , offsets1BitMap, " = Ptr\n" + , " \"", enumMapToAddrLiteral' + 4 + 50 + (Shamochu.offsets1IntSize stats `shiftR` 3) + (Exts.toList offset1Array) + "\"#\n" + , "\n" + , offsets2BitMap, " :: Ptr ", offset2Type, "\n" + , offsets2BitMap, " = Ptr\n" + , " \"", enumMapToAddrLiteral' + 4 + 50 + (Shamochu.offsets2IntSize stats `shiftR` 3) + (Exts.toList offsets2Array) + "\"#\n" + ] + imports = case mapType of + BitMap + | rawInt -> error "unsupported" + | otherwise -> defaultBitMapImports + (Shamochu.offsets1IntSize stats) + <+> wordImport (Shamochu.offsets2IntSize stats) + <+> lookupFuncImport (Shamochu.offsets2IntSize stats) + <+> defaultByteMapImportsBoxed + ByteMap + | rawInt -> defaultByteMapImports + (Shamochu.dataIntSize stats) + (Shamochu.offsets1IntSize stats) + <+> wordImport (Shamochu.offsets2IntSize stats) + <+> lookupFuncImport (Shamochu.offsets2IntSize stats) + <+> defaultByteMapImportsUnboxed + | otherwise -> defaultByteMapImports + (Shamochu.dataIntSize stats) + (Shamochu.offsets1IntSize stats) + <+> wordImport (Shamochu.offsets2IntSize stats) + <+> lookupFuncImport (Shamochu.offsets2IntSize stats) + <+> defaultByteMapImportsBoxed Shamochu.CompressedArray{array=dataArray} = array1 Shamochu.CompressedArray{array=offset1Array, offsets=offsets2Array} = array2 dataBitMap = nameBB <> "DataBitMap" @@ -795,6 +875,12 @@ generateShamochuBitmaps name rawInt mapType powersStage1 powersStage2 convert xs , " ", addrName, "# (\n" , index, "\n" , mkIndent indent, ")" ] + mkWordLookupFunc dataSize = mconcat + [ "lookupWord" + , fromString (show dataSize) + , "AsInt" + , if rawInt then "#" else "" ] + mkWord dataSize = "Word" <> fromString (show dataSize) mkMaskDef mask count = if rawInt then mconcat [mask, " = (1# `iShiftL#` ", BB.wordDec count, "#) -# 1#\n"] else mconcat [mask, " = (1 `shiftL` ", BB.wordDec count, ") - 1\n"] @@ -806,6 +892,38 @@ generateShamochuBitmaps name rawInt mapType powersStage1 powersStage2 convert xs then mconcat [n, " `iShiftRL#` ", BB.wordDec count, "#"] else mconcat [n, " `shiftR` ", BB.wordDec count] mkShiftR' n count = "(" <> mkShiftR n count <> ")" + defaultBitMapImports offsetsSize = Map.fromList + [ ( "Data.Char", Set.singleton "ord" ) + , ( "Data.Int", Set.singleton "Int8" ) + , ( "Data.Word", Set.singleton (mkWord offsetsSize) ) + , ( "GHC.Exts", Set.singleton "Ptr(..)" ) + , ( "Unicode.Internal.Bits" + , Set.fromList + [ "lookupBit" + , mkWordLookupFunc offsetsSize ] + ) + ] + defaultByteMapImports dataSize offsetsSize = Map.fromList + [ ( "Data.Char", Set.singleton "ord" ) + , ( "Data.Int", Set.singleton "Int8" ) + , ( "Data.Word", Set.singleton (mkWord offsetsSize) ) + , ( "GHC.Exts", Set.singleton "Ptr(..)" ) + , ( "Unicode.Internal.Bits" + , Set.fromList + [ mkWordLookupFunc dataSize + , mkWordLookupFunc offsetsSize ] + ) + ] + defaultByteMapImportsBoxed = Map.singleton + "Data.Bits" + (Set.singleton "Bits(..)") + defaultByteMapImportsUnboxed = Map.singleton + "GHC.Exts" + (Set.fromList ["Int#", "andI#", "iShiftL#", "iShiftRL#", "(+#)", "(-#)"]) + wordImport w = Map.singleton "Data.Word" (Set.singleton (mkWord w)) + lookupFuncImport size = Map.singleton + "Unicode.Internal.Bits" + (Set.singleton (mkWordLookupFunc size)) toLookupBitMapName :: String -> BB.Builder toLookupBitMapName name = "lookup" <> BB.string7 (toTitle name) <> "BitMap" @@ -824,3 +942,35 @@ unlinesBB = (<> "\n") . mconcat . L.intersperse "\n" unwordsBB :: [BB.Builder] -> BB.Builder unwordsBB = mconcat . L.intersperse " " + +mkImports :: Imports -> BB.Builder +mkImports = Map.foldMapWithKey \module_ xs -> mconcat + [ "import ", BB.shortByteString module_, " (" + , foldMap BB.shortByteString + ( L.intersperse ", " + . fmap getImportItem + . Set.toAscList + . Set.map ImportItem + $ xs ) + , ")\n" ] + +-- | Make operators appear last +newtype ImportItem = ImportItem { getImportItem :: BS.ShortByteString } + deriving newtype (Eq) + +instance Ord ImportItem where + ImportItem i1 `compare` ImportItem i2 = case compare (isOperator i1) (isOperator i2) of + EQ -> compare i1 i2 + cmp -> cmp + where + isOperator i = case BS.unpack i of + [] -> False + w:_ -> not (isAlpha (chr (fromIntegral w))) + +mkImports' :: BS.ShortByteString -> Imports -> BB.Builder +mkImports' p = mkImports . Map.mapKeys \case + "Unicode.Internal.Bits" -> "Unicode.Internal.Bits." <> p + k -> k + +(<+>) :: (Ord k, Semigroup v) => Map.Map k v -> Map.Map k v -> Map.Map k v +(<+>) = Map.unionWith (<>) diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/Properties.hs b/ucd2haskell/exe/UCD2Haskell/Modules/Properties.hs index dd78f42..b6abb8d 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/Properties.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/Properties.hs @@ -25,8 +25,10 @@ import qualified Unicode.CharacterDatabase.Parser.Properties.Multiple as Props import UCD2Haskell.Common (Fold (..)) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, genBitmapShamochu, + mkImports, unlinesBB, ) @@ -78,20 +80,21 @@ genCorePropertiesModule moduleName isProp = Fold step initial done Nothing -> Just xs Just ys -> Just (xs <> ys) - done Acc{..} = unlinesBB (header properties <> genBitmaps values properties) + done Acc{..} = header imports properties <> code + where + ShamochuCode{..} = genBitmaps values properties - genBitmaps values = foldr addBitMap mempty + genBitmaps values = foldMap addBitMap where addBitMap property = - (:) - (genBitmapShamochu + genBitmapShamochu (prop2FuncNameStr property) (5 NE.:| [6, 7]) -- [2,3,4,5,6] [] - (IntSet.toAscList (values Map.! property))) + (IntSet.toAscList (values Map.! property)) - header exports = + header imports exports = unlinesBB [ apacheLicense 2020 moduleName , "{-# OPTIONS_HADDOCK hide #-}" , "{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}" @@ -102,11 +105,5 @@ genCorePropertiesModule moduleName isProp = Fold step initial done <> mconcat (L.intersperse "\n , " (map prop2FuncName exports)) , " ) where" , "" - , "import Data.Bits (Bits(..))" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.Word (Word8, Word16)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt)" - , "" + , mkImports imports ] diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/Scripts.hs b/ucd2haskell/exe/UCD2Haskell/Modules/Scripts.hs index 72a2e1b..91c0af3 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/Scripts.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/Scripts.hs @@ -35,11 +35,14 @@ import UCD2Haskell.Common ( import UCD2Haskell.Generator ( BitmapType (..), FileRecipe (..), + ShamochuCode (..), apacheLicense, generateShamochuBitmaps, + mkImports', toLookupBitMapName, unlinesBB, word32ToWord8s, + (<+>), ) recipe :: PropertyValuesAliases -> FileRecipe Prop.Entry @@ -56,6 +59,13 @@ genScriptsModule moduleName aliases = Fold step mempty done done ranges = let scripts = Set.toList (foldr addScript (Set.singleton Defaults.defaultScript) ranges) + ShamochuCode{..} = if length scripts <= 0xff + then mkCharScripts scripts ranges + else error "Cannot encode scripts" + imports' = imports <+> Map.fromList + [ ( "GHC.Exts" + , Set.fromList ["Addr#", "Int(..)", "nullAddr#"] ) + , ( "Data.Ix", Set.singleton "Ix" )] in unlinesBB [ "{-# LANGUAGE PatternSynonyms #-}" , "{-# OPTIONS_HADDOCK hide #-}" @@ -71,13 +81,7 @@ genScriptsModule moduleName aliases = Fold step mempty done , " , pattern ScriptCharMaskComplement )" , "where" , "" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.Ix (Ix)" - , "import Data.Word (Word16)" - , "import GHC.Exts (Addr#, Int#, Int(..), Ptr(..), nullAddr#, andI#, iShiftL#, iShiftRL#, (+#), (-#))" - , "import Unicode.Internal.Bits.Scripts (lookupWord8AsInt#, lookupWord16AsInt#)" - , "" + , mkImports' "Scripts" imports' , "-- | Unicode [script](https://www.unicode.org/reports/tr24/)." , "--" , "-- The constructors descriptions are the original Unicode values" @@ -127,9 +131,7 @@ genScriptsModule moduleName aliases = Fold step mempty done , "-- | Script of a character." , "--" , "-- @since 0.1.0" - , if length scripts <= 0xff - then mkCharScripts scripts ranges - else error "Cannot encode scripts" + , code , "" ] @@ -297,7 +299,7 @@ genScriptsModule moduleName aliases = Fold step mempty done encodeBytes = foldr addByte "" . word32ToWord8s addByte n acc = BB.char7 '\\' <> BB.word8Dec n <> acc - mkCharScripts :: [BS.ShortByteString] -> [Prop.Entry] -> BB.Builder + mkCharScripts :: [BS.ShortByteString] -> [Prop.Entry] -> ShamochuCode mkCharScripts scripts scriptsRanges = let charScripts = L.sort (foldMap (rangeToCharScripts getScript) scriptsRanges) charScripts' = reverse (fst (foldl' addMissing (mempty, '\0') charScripts)) @@ -325,28 +327,32 @@ genScriptsModule moduleName aliases = Fold step mempty done assert (fromEnum (length scripts) < 0xff) (fromIntegral . fromEnum) bitmap0To1 = "scriptPlanes0To1" - in mconcat - [ "{-# INLINE script #-}\n" - , "script :: Char -> Int#\n" - , "script c\n" - , " -- Planes 0-1\n" - , " | cp < 0x", showPaddedHeXB boundPlanes0To1 - , " = ", toLookupBitMapName bitmap0To1, " cp#\n" - , mkScriptsBounds def (scripts !!) otherPlanes - , " -- Default: ", BB.shortByteString Defaults.defaultScript, "\n" - , " | otherwise = ", BB.intDec def, "#\n" - , " where\n" - , " !cp@(I# cp#) = ord c\n" - , "\n" - , generateShamochuBitmaps - bitmap0To1 - True - ByteMap - (NE.singleton 3) - [5] - toWord8 - planes0To1 - ] + ShamochuCode{..} = generateShamochuBitmaps + bitmap0To1 + True + ByteMap + (NE.singleton 3) + [5] + toWord8 + planes0To1 + in ShamochuCode + { code = mconcat + [ "{-# INLINE script #-}\n" + , "script :: Char -> Int#\n" + , "script c\n" + , " -- Planes 0-1\n" + , " | cp < 0x", showPaddedHeXB boundPlanes0To1 + , " = ", toLookupBitMapName bitmap0To1, " cp#\n" + , mkScriptsBounds def (scripts !!) otherPlanes + , " -- Default: ", BB.shortByteString Defaults.defaultScript, "\n" + , " | otherwise = ", BB.intDec def, "#\n" + , " where\n" + , " !cp@(I# cp#) = ord c\n" + , "\n" + , code + ] + , imports = imports } + mkScriptsBounds :: Int -> (Int -> BS.ShortByteString) -> [(Int,Char)] -> BB.Builder mkScriptsBounds def getScriptName diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/ScriptsExtensions.hs b/ucd2haskell/exe/UCD2Haskell/Modules/ScriptsExtensions.hs index d6cf54d..333be50 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/ScriptsExtensions.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/ScriptsExtensions.hs @@ -27,11 +27,14 @@ import qualified Unicode.CharacterDatabase.Parser.Properties.Single as Prop import UCD2Haskell.Common (Fold (..), mkHaskellConstructor) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, enumMapToAddrLiteral, genEnumBitmapShamochu, + mkImports', splitPlanes, unlinesBB, + (<+>), ) recipe :: PropertyValuesAliases -> ScriptExtensions -> FileRecipe Prop.Entry @@ -98,14 +101,7 @@ genScriptExtensionsModule moduleName aliases extensions = Fold step initial done , "(scriptExtensions)" , "where" , "" - , "import Data.Char (ord)" - , "import Data.Word (Word8, Word16)" - , "import Data.Int (Int8)" - , "import GHC.Exts" - , " ( Addr#, Int#, Int(..), Ptr(..), nullAddr#" - , " , negateInt#, andI#, iShiftL#, iShiftRL#, (+#), (-#) )" - , "import Unicode.Internal.Bits.Scripts (lookupWord8AsInt#, lookupWord16AsInt#)" - , "" + , mkImports' "Scripts" imports' , "-- | Script extensions of a character." , "--" , "-- Returns a pair:" @@ -123,16 +119,7 @@ genScriptExtensionsModule moduleName aliases extensions = Fold step initial done (usedExts Set.\\ singleScriptExtensionsSet) , " s -> (# negateInt# s, nullAddr# #)" , "" - , genEnumBitmapShamochu - "encodedScriptExtensions" - True - (NE.singleton 3) - [5] - toWord8 - (def, BB.intDec (fromEnum def)) - (def, BB.intDec (fromEnum def)) - planes0To3 - plane14 + , code ] where -- List ordered by Haskell constructors @@ -174,6 +161,19 @@ genScriptExtensionsModule moduleName aliases extensions = Fold step initial done "Cannot generate: genScriptExtensionsModule" (== def) scriptExtensions + ShamochuCode{..} = genEnumBitmapShamochu + "encodedScriptExtensions" + True + (NE.singleton 3) + [5] + toWord8 + (def, BB.intDec (fromEnum def)) + (def, BB.intDec (fromEnum def)) + planes0To3 + plane14 + imports' = imports <+> Map.singleton + "GHC.Exts" + (Set.fromList ["Addr#", "Int(..)", "nullAddr#", "negateInt#"]) mkDecodeScriptExtensions :: (NE.NonEmpty BS.ShortByteString -> Word8) diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierStatus.hs b/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierStatus.hs index 7568461..3cfcbcb 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierStatus.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierStatus.hs @@ -16,8 +16,10 @@ import qualified Unicode.CharacterDatabase.Parser.Properties.Single as Prop import UCD2Haskell.Common (Fold (..)) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, genBitmapShamochu, + mkImports, unlinesBB, ) @@ -46,14 +48,12 @@ genIdentifierStatusModule moduleName = Fold step mempty done , "(isAllowedInIdentifier)" , "where" , "" - , "import Data.Char (ord)" - , "import Data.Word (Word8)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupBit)" - , "" - , genBitmapShamochu - "isAllowedInIdentifier" - (NE.singleton 6) - [2,3,4,5,6] - (reverse values) + , mkImports imports + , code ] + where + ShamochuCode{..} = genBitmapShamochu + "isAllowedInIdentifier" + (NE.singleton 6) + [2,3,4,5,6] + (reverse values) diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierType.hs b/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierType.hs index 6cf461b..757cb32 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierType.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/Security/IdentifierType.hs @@ -23,10 +23,13 @@ import qualified Unicode.CharacterDatabase.Parser.Properties.Single as Prop import UCD2Haskell.Common (Fold (..)) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, genEnumBitmapShamochu, + mkImports, splitPlanes, unlinesBB, + (<+>), ) recipe :: FileRecipe Prop.Entry @@ -152,14 +155,7 @@ genIdentifierTypeModule moduleName = Fold step mempty done , "(IdentifierType(..), identifierTypes, decodeIdentifierTypes)" , "where" , "" - , "import Data.Bits (Bits(..))" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.List.NonEmpty (NonEmpty)" - , "import Data.Word (Word8, Word16)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupWord8AsInt, lookupWord16AsInt)" - , "" + , mkImports (imports <+> Map.singleton "Data.List.NonEmpty" (Set.singleton "NonEmpty")) , "-- | Identifier type" , "--" , "-- @since 0.1.0" @@ -203,16 +199,7 @@ genIdentifierTypeModule moduleName = Fold step mempty done , " _ -> " <> mkHaskellConstructorsList def , "" , "-- | Returns the 'IdentifierType's corresponding to a character." - , genEnumBitmapShamochu - "identifierTypes" - False - (NE.singleton 3) - [5] - toWord8 - (defIdx, BB.intDec (fromEnum defIdx)) - (defIdx, BB.intDec (fromEnum defIdx)) - planes0To3 - plane14 + , code ] where toWord8 = @@ -223,3 +210,13 @@ genIdentifierTypeModule moduleName = Fold step mempty done (== defIdx) (reverse identifiersTypes) (encoding, identifiersTypes, defIdx) = mkIdentifiersTypes acc + ShamochuCode{..} = genEnumBitmapShamochu + "identifierTypes" + False + (NE.singleton 3) + [5] + toWord8 + (defIdx, BB.intDec (fromEnum defIdx)) + (defIdx, BB.intDec (fromEnum defIdx)) + planes0To3 + plane14 diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/CombiningClass.hs b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/CombiningClass.hs index e1ef9a6..74ed9f5 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/CombiningClass.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/CombiningClass.hs @@ -21,8 +21,10 @@ import qualified Unicode.CharacterDatabase.Parser.UnicodeData as UD import UCD2Haskell.Common (Fold (..), showB) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, genBitmapShamochu, + mkImports, unlinesBB, ) @@ -60,24 +62,20 @@ genCombiningClassModule moduleName = Fold step initial done , "(combiningClass, isCombining)" , "where" , "" - , "import Data.Bits (Bits(..))" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.Word (Word8, Word16)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt)" - , "" + , mkImports imports , "combiningClass :: Char -> Int" , "combiningClass = \\case" , unlinesBB (reverse combiningClasses) , " _ -> 0\n" , "" - , genBitmapShamochu - "isCombining" - (NE.singleton 6) - [2,3,4,5,6] - (reverse combiningCodePoints) + , code ] + where + ShamochuCode{..} = genBitmapShamochu + "isCombining" + (NE.singleton 6) + [2,3,4,5,6] + (reverse combiningCodePoints) genCombiningClassDef c cc = mconcat [ " " diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Composition.hs b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Composition.hs index d814a38..4979bc6 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Composition.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Composition.hs @@ -21,8 +21,10 @@ import qualified Unicode.CharacterDatabase.Parser.UnicodeData as UD import UCD2Haskell.Common (Fold (..), allRange, isHangulRange, showB) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, genBitmapShamochu, + mkImports, unlinesBB, ) @@ -92,7 +94,7 @@ genCompositionsModule moduleName excluded combiningChars = then Set.insert secondCP secondStarters else secondStarters - header = + header imports = [ apacheLicense 2020 moduleName , "{-# OPTIONS_HADDOCK hide #-}" , "" @@ -100,13 +102,7 @@ genCompositionsModule moduleName excluded combiningChars = , "(compose, composeStarters, isSecondStarter)" , "where" , "" - , "import Data.Bits (Bits(..))" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.Word (Word8, Word16)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt)" - , "" + , mkImports imports ] composePair decomps = @@ -125,17 +121,19 @@ genCompositionsModule moduleName excluded combiningChars = ] isSecondStarter secondStarters = - [ genBitmapShamochu - "isSecondStarter" - (NE.singleton 6) - [2,3,4,5,6] - (Set.toAscList secondStarters) ] + genBitmapShamochu + "isSecondStarter" + (NE.singleton 6) + [2,3,4,5,6] + (Set.toAscList secondStarters) done Acc{..} = unlinesBB . mconcat $ - [ header + [ header imports , composePair (reverse decompositions) , composeStarterPair (reverse starters) - , isSecondStarter secondStarters ] + , [code] ] + where + ShamochuCode{..} = isSecondStarter secondStarters parseFullCompositionExclusion :: B.ByteString -> Set.Set Char parseFullCompositionExclusion = foldr addExcluded mempty . Props.parse diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Decomposition.hs b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Decomposition.hs index 913ea22..41c89f2 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Decomposition.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/Decomposition.hs @@ -26,8 +26,10 @@ import qualified Unicode.CharacterDatabase.Parser.UnicodeData as UD import UCD2Haskell.Common (Fold (..), allRange, filterFold, filterNonHangul, showB) import UCD2Haskell.Generator ( FileRecipe (..), + ShamochuCode (..), apacheLicense, genBitmapShamochu, + mkImports, unlinesBB, unwordsBB, ) @@ -76,19 +78,15 @@ genDecomposableModule moduleName dtype , "(isDecomposable)" , "where" , "" - , "import Data.Bits (Bits(..))" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.Word (Word8, Word16)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt)" - , "" - , genBitmapShamochu - "isDecomposable" - (NE.singleton 6) - [2,3,4,5,6] - (reverse st) + , mkImports imports + , code ] + where + ShamochuCode{..} = genBitmapShamochu + "isDecomposable" + (NE.singleton 6) + [2,3,4,5,6] + (reverse st) filterDecomposableType :: DType -> Fold UD.Entry a -> Fold UD.Entry a filterDecomposableType dtype = diff --git a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/GeneralCategory.hs b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/GeneralCategory.hs index 6dd5165..c49b5ff 100644 --- a/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/GeneralCategory.hs +++ b/ucd2haskell/exe/UCD2Haskell/Modules/UnicodeData/GeneralCategory.hs @@ -21,7 +21,7 @@ import UCD2Haskell.Generator ( FileRecipe (..), apacheLicense, genEnumBitmapShamochu, - unlinesBB, + unlinesBB, ShamochuCode (..), mkImports, ) import Control.Exception (assert) @@ -107,13 +107,7 @@ genGeneralCategoryModule moduleName = Fold step initial done , foldMapWithNewLine mkCharBoundPatternExport charBoundPatterns , ") where" , "" - , "import Data.Bits (Bits(..))" - , "import Data.Char (ord)" - , "import Data.Int (Int8)" - , "import Data.Word (Word8, Word16)" - , "import GHC.Exts (Ptr(..))" - , "import Unicode.Internal.Bits (lookupWord8AsInt, lookupWord16AsInt)" - , "" + , mkImports imports , "--------------------------------------------------------------------------------" , "-- General category patterns" , "--------------------------------------------------------------------------------" @@ -134,16 +128,7 @@ genGeneralCategoryModule moduleName = Fold step initial done , "generalCategoryPlanes0To3 = lookupGeneralCategoryBitMap" , "" , "-- | Return the general category of a character" - , genEnumBitmapShamochu - "generalCategory" - False - (NE.singleton 3) - [5] - toWord8 - (UD.Co, generalCategoryConstructor UD.Co) - (UD.Cn, generalCategoryConstructor UD.Cn) - (reverse acc1) - (reverse acc2) + , code ] where toWord8 = @@ -173,6 +158,16 @@ genGeneralCategoryModule moduleName = Fold step initial done , ("MaxIsNumber" , maxIsNumber ) , ("MaxIsSpace" , maxIsSpace ) , ("MaxIsSeparator", maxIsSeparator) ] + ShamochuCode{..} = genEnumBitmapShamochu + "generalCategory" + False + (NE.singleton 3) + [5] + toWord8 + (UD.Co, generalCategoryConstructor UD.Co) + (UD.Cn, generalCategoryConstructor UD.Cn) + (reverse acc1) + (reverse acc2) data CharBounds = CharBounds { maxIsLetter :: !Char diff --git a/unicode-data-scripts/lib/Unicode/Internal/Char/ScriptExtensions.hs b/unicode-data-scripts/lib/Unicode/Internal/Char/ScriptExtensions.hs index a2b3405..8dbe7b7 100644 --- a/unicode-data-scripts/lib/Unicode/Internal/Char/ScriptExtensions.hs +++ b/unicode-data-scripts/lib/Unicode/Internal/Char/ScriptExtensions.hs @@ -13,12 +13,10 @@ module Unicode.Internal.Char.ScriptExtensions where import Data.Char (ord) -import Data.Word (Word8, Word16) import Data.Int (Int8) -import GHC.Exts - ( Addr#, Int#, Int(..), Ptr(..), nullAddr# - , negateInt#, andI#, iShiftL#, iShiftRL#, (+#), (-#) ) -import Unicode.Internal.Bits.Scripts (lookupWord8AsInt#, lookupWord16AsInt#) +import Data.Word (Word16) +import GHC.Exts (Addr#, Int#, Int(..), Ptr(..), andI#, iShiftL#, iShiftRL#, negateInt#, nullAddr#, (+#), (-#)) +import Unicode.Internal.Bits.Scripts (lookupWord16AsInt#, lookupWord8AsInt#) -- | Script extensions of a character. -- diff --git a/unicode-data-scripts/lib/Unicode/Internal/Char/Scripts.hs b/unicode-data-scripts/lib/Unicode/Internal/Char/Scripts.hs index 2b3e495..4ddb741 100644 --- a/unicode-data-scripts/lib/Unicode/Internal/Char/Scripts.hs +++ b/unicode-data-scripts/lib/Unicode/Internal/Char/Scripts.hs @@ -23,8 +23,8 @@ import Data.Char (ord) import Data.Int (Int8) import Data.Ix (Ix) import Data.Word (Word16) -import GHC.Exts (Addr#, Int#, Int(..), Ptr(..), nullAddr#, andI#, iShiftL#, iShiftRL#, (+#), (-#)) -import Unicode.Internal.Bits.Scripts (lookupWord8AsInt#, lookupWord16AsInt#) +import GHC.Exts (Addr#, Int#, Int(..), Ptr(..), andI#, iShiftL#, iShiftRL#, nullAddr#, (+#), (-#)) +import Unicode.Internal.Bits.Scripts (lookupWord16AsInt#, lookupWord8AsInt#) -- | Unicode [script](https://www.unicode.org/reports/tr24/). -- diff --git a/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierStatus.hs b/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierStatus.hs index 48aa1b0..f0fbd34 100644 --- a/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierStatus.hs +++ b/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierStatus.hs @@ -12,10 +12,12 @@ module Unicode.Internal.Char.Security.IdentifierStatus (isAllowedInIdentifier) where +import Data.Bits (Bits(..)) import Data.Char (ord) -import Data.Word (Word8) +import Data.Int (Int8) +import Data.Word (Word16, Word8) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit) +import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) {-# INLINE isAllowedInIdentifier #-} isAllowedInIdentifier :: Char -> Bool diff --git a/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierType.hs b/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierType.hs index feda4e4..baa5563 100644 --- a/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierType.hs +++ b/unicode-data-security/lib/Unicode/Internal/Char/Security/IdentifierType.hs @@ -17,9 +17,9 @@ import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) import Data.List.NonEmpty (NonEmpty) -import Data.Word (Word8, Word16) +import Data.Word (Word16) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupWord8AsInt, lookupWord16AsInt) +import Unicode.Internal.Bits (lookupWord16AsInt, lookupWord8AsInt) -- | Identifier type -- diff --git a/unicode-data/lib/Unicode/Internal/Char/DerivedCoreProperties.hs b/unicode-data/lib/Unicode/Internal/Char/DerivedCoreProperties.hs index e916173..75362d3 100644 --- a/unicode-data/lib/Unicode/Internal/Char/DerivedCoreProperties.hs +++ b/unicode-data/lib/Unicode/Internal/Char/DerivedCoreProperties.hs @@ -23,9 +23,9 @@ module Unicode.Internal.Char.DerivedCoreProperties import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word16) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) +import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt) {-# INLINE isXID_Continue #-} isXID_Continue :: Char -> Bool diff --git a/unicode-data/lib/Unicode/Internal/Char/PropList.hs b/unicode-data/lib/Unicode/Internal/Char/PropList.hs index 8a80248..0d84bfe 100644 --- a/unicode-data/lib/Unicode/Internal/Char/PropList.hs +++ b/unicode-data/lib/Unicode/Internal/Char/PropList.hs @@ -19,9 +19,9 @@ module Unicode.Internal.Char.PropList import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word8) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) +import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt) {-# INLINE isPattern_Syntax #-} isPattern_Syntax :: Char -> Bool diff --git a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/CombiningClass.hs b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/CombiningClass.hs index b950464..0adcd44 100644 --- a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/CombiningClass.hs +++ b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/CombiningClass.hs @@ -14,9 +14,9 @@ where import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word16, Word8) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt) +import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) combiningClass :: Char -> Int combiningClass = \case diff --git a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Compositions.hs b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Compositions.hs index 33ad7c8..d235e1b 100644 --- a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Compositions.hs +++ b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Compositions.hs @@ -15,9 +15,9 @@ where import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word16, Word8) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt) +import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) {-# NOINLINE compose #-} compose :: Char -> Char -> Maybe Char diff --git a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Decomposable.hs b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Decomposable.hs index 822c058..e7ae0e5 100644 --- a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Decomposable.hs +++ b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/Decomposable.hs @@ -15,9 +15,9 @@ where import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word16, Word8) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt) +import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) {-# INLINE isDecomposable #-} isDecomposable :: Char -> Bool diff --git a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/DecomposableK.hs b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/DecomposableK.hs index 4e5a926..a80b999 100644 --- a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/DecomposableK.hs +++ b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/DecomposableK.hs @@ -15,9 +15,9 @@ where import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word16, Word8) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupBit, lookupWord8AsInt, lookupWord16AsInt) +import Unicode.Internal.Bits (lookupBit, lookupWord16AsInt, lookupWord8AsInt) {-# INLINE isDecomposable #-} isDecomposable :: Char -> Bool diff --git a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs index 8d2a97e..787959d 100644 --- a/unicode-data/lib/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs +++ b/unicode-data/lib/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs @@ -59,9 +59,9 @@ module Unicode.Internal.Char.UnicodeData.GeneralCategory import Data.Bits (Bits(..)) import Data.Char (ord) import Data.Int (Int8) -import Data.Word (Word8, Word16) +import Data.Word (Word16) import GHC.Exts (Ptr(..)) -import Unicode.Internal.Bits (lookupWord8AsInt, lookupWord16AsInt) +import Unicode.Internal.Bits (lookupWord16AsInt, lookupWord8AsInt) -------------------------------------------------------------------------------- -- General category patterns