X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FUnicode.hs;h=b34f677069d1f12fb6d6514192b0b33886747122;hb=HEAD;hp=5b7d47bd47a873058febb1e3d183b764f002c4e6;hpb=b8aa439a9361fdcc59c722df8c8ed3ca31e91105;p=ghc-base.git diff --git a/GHC/Unicode.hs b/GHC/Unicode.hs index 5b7d47b..b34f677 100644 --- a/GHC/Unicode.hs +++ b/GHC/Unicode.hs @@ -1,7 +1,10 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-} +{-# OPTIONS -#include "WCsubst.h" #-} +{-# OPTIONS_HADDOCK hide #-} + ----------------------------------------------------------------------------- -- | --- Module : GHC.Unicde +-- Module : GHC.Unicode -- Copyright : (c) The University of Glasgow, 2003 -- License : see libraries/base/LICENSE -- @@ -15,35 +18,41 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.Unicode ( isAscii, isLatin1, isControl, isAsciiUpper, isAsciiLower, isPrint, isSpace, isUpper, isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum, - toUpper, toLower, + toUpper, toLower, toTitle, + wgencat, ) where import GHC.Base -import GHC.Real (fromIntegral) -import GHC.Int -import GHC.Word -import GHC.Num (fromInteger) +import GHC.Real (fromIntegral) +import Foreign.C.Types (CInt) -#include "ghcconfig.h" +#include "HsBaseConfig.h" -- | Selects the first 128 characters of the Unicode character set, -- corresponding to the ASCII character set. isAscii :: Char -> Bool -isAscii c = c < '\x80' +isAscii c = c < '\x80' -- | Selects the first 256 characters of the Unicode character set, -- corresponding to the ISO 8859-1 (Latin-1) character set. isLatin1 :: Char -> Bool isLatin1 c = c <= '\xff' -isAsciiUpper, isAsciiLower :: Char -> Bool +-- | Selects ASCII lower-case letters, +-- i.e. characters satisfying both 'isAscii' and 'isLower'. +isAsciiLower :: Char -> Bool isAsciiLower c = c >= 'a' && c <= 'z' + +-- | Selects ASCII upper-case letters, +-- i.e. characters satisfying both 'isAscii' and 'isUpper'. +isAsciiUpper :: Char -> Bool isAsciiUpper c = c >= 'A' && c <= 'Z' -- | Selects control characters, which are the non-printing characters of @@ -54,38 +63,32 @@ isControl :: Char -> Bool -- (letters, numbers, marks, punctuation, symbols and spaces). isPrint :: Char -> Bool --- | Selects white-space characters in the Latin-1 range. --- (In Unicode terms, this includes spaces and some control characters.) +-- | Returns 'True' for any Unicode space character, and the control +-- characters @\\t@, @\\n@, @\\r@, @\\f@, @\\v@. isSpace :: Char -> Bool -- isSpace includes non-breaking space -- Done with explicit equalities both for efficiency, and to avoid a tiresome -- recursion with GHC.List elem -isSpace c = c == ' ' || - c == '\t' || - c == '\n' || - c == '\r' || - c == '\f' || - c == '\v' || - c == '\xa0' - --- | Selects alphabetic Unicode characters (letters) that are not lower-case. --- (In Unicode terms, this includes letters in upper and title cases, --- as well as modifier letters and other letters.) +isSpace c = c == ' ' || + c == '\t' || + c == '\n' || + c == '\r' || + c == '\f' || + c == '\v' || + c == '\xa0' || + iswspace (fromIntegral (ord c)) /= 0 + +-- | Selects upper-case or title-case alphabetic Unicode characters (letters). +-- Title case is used by a small number of letter ligatures like the +-- single-character form of /Lj/. isUpper :: Char -> Bool -- | Selects lower-case alphabetic Unicode characters (letters). isLower :: Char -> Bool --- | Selects alphabetic Unicode characters (letters). --- --- Note: the Haskell 98 definition of 'isAlpha' is: --- --- > isAlpha c = isUpper c || isLower c --- --- the implementation here diverges from the Haskell 98 --- definition in the sense that Unicode alphabetic characters which --- are neither upper nor lower case will still be identified as --- alphabetic by 'isAlpha'. +-- | Selects alphabetic Unicode characters (lower-case, upper-case and +-- title-case letters, plus letters of caseless scripts and modifiers letters). +-- This function is equivalent to 'Data.Char.isLetter'. isAlpha :: Char -> Bool -- | Selects alphabetic or numeric digit Unicode characters. @@ -97,45 +100,40 @@ isAlphaNum :: Char -> Bool -- | Selects ASCII digits, i.e. @\'0\'@..@\'9\'@. isDigit :: Char -> Bool +isDigit c = c >= '0' && c <= '9' -- | Selects ASCII octal digits, i.e. @\'0\'@..@\'7\'@. isOctDigit :: Char -> Bool -isOctDigit c = c >= '0' && c <= '7' +isOctDigit c = c >= '0' && c <= '7' -- | Selects ASCII hexadecimal digits, -- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@. isHexDigit :: Char -> Bool -isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || +isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f' --- | Convert a letter to the corresponding upper-case letter, leaving any --- other character unchanged. Any Unicode letter which has an upper-case --- equivalent is transformed. +-- | Convert a letter to the corresponding upper-case letter, if any. +-- Any other character is returned unchanged. toUpper :: Char -> Char --- | Convert a letter to the corresponding lower-case letter, leaving any --- other character unchanged. Any Unicode letter which has a lower-case --- equivalent is transformed. +-- | Convert a letter to the corresponding lower-case letter, if any. +-- Any other character is returned unchanged. toLower :: Char -> Char --- ----------------------------------------------------------------------------- --- Win32 implementation - -#if (defined(HAVE_WCTYPE_H) && HAVE_ISWSPACE && defined(HTYPE_WINT_T)) || mingw32_TARGET_OS +-- | Convert a letter to the corresponding title-case or upper-case +-- letter, if any. (Title case differs from upper case only for a small +-- number of ligature letters.) +-- Any other character is returned unchanged. +toTitle :: Char -> Char --- Use the wide-char classification functions if available. Glibc --- seems to implement these properly, even for chars > 0xffff, as long --- as you call setlocale() to set the locale to something other than --- "C". Therefore, we call setlocale() in hs_init(). +-- ----------------------------------------------------------------------------- +-- Implementation with the supplied auto-generated Unicode character properties +-- table (default) --- Win32 uses UTF-16, so presumably the system-supplied iswlower() and --- friends won't work properly with characters > 0xffff. These --- characters are represented as surrogate pairs in UTF-16. +#if 1 -type WInt = HTYPE_WINT_T -type CInt = HTYPE_INT +-- Regardless of the O/S and Library, use the functions contained in WCsubst.c -isDigit c = iswdigit (fromIntegral (ord c)) /= 0 isAlpha c = iswalpha (fromIntegral (ord c)) /= 0 isAlphaNum c = iswalnum (fromIntegral (ord c)) /= 0 --isSpace c = iswspace (fromIntegral (ord c)) /= 0 @@ -146,59 +144,62 @@ isLower c = iswlower (fromIntegral (ord c)) /= 0 toLower c = chr (fromIntegral (towlower (fromIntegral (ord c)))) toUpper c = chr (fromIntegral (towupper (fromIntegral (ord c)))) +toTitle c = chr (fromIntegral (towtitle (fromIntegral (ord c)))) + +foreign import ccall unsafe "u_iswalpha" + iswalpha :: CInt -> CInt -foreign import ccall unsafe "iswdigit" - iswdigit :: WInt -> CInt +foreign import ccall unsafe "u_iswalnum" + iswalnum :: CInt -> CInt -foreign import ccall unsafe "iswalpha" - iswalpha :: WInt -> CInt +foreign import ccall unsafe "u_iswcntrl" + iswcntrl :: CInt -> CInt -foreign import ccall unsafe "iswalnum" - iswalnum :: WInt -> CInt +foreign import ccall unsafe "u_iswspace" + iswspace :: CInt -> CInt -foreign import ccall unsafe "iswcntrl" - iswcntrl :: WInt -> CInt +foreign import ccall unsafe "u_iswprint" + iswprint :: CInt -> CInt -foreign import ccall unsafe "iswspace" - iswspace :: WInt -> CInt +foreign import ccall unsafe "u_iswlower" + iswlower :: CInt -> CInt -foreign import ccall unsafe "iswprint" - iswprint :: WInt -> CInt +foreign import ccall unsafe "u_iswupper" + iswupper :: CInt -> CInt -foreign import ccall unsafe "iswlower" - iswlower :: WInt -> CInt +foreign import ccall unsafe "u_towlower" + towlower :: CInt -> CInt -foreign import ccall unsafe "iswupper" - iswupper :: WInt -> CInt +foreign import ccall unsafe "u_towupper" + towupper :: CInt -> CInt -foreign import ccall unsafe "towlower" - towlower :: WInt -> WInt +foreign import ccall unsafe "u_towtitle" + towtitle :: CInt -> CInt -foreign import ccall unsafe "towupper" - towupper :: WInt -> WInt +foreign import ccall unsafe "u_gencat" + wgencat :: CInt -> CInt -- ----------------------------------------------------------------------------- --- No libunicode, so fall back to the ASCII-only implementation +-- No libunicode, so fall back to the ASCII-only implementation (never used, indeed) #else -isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f' -isPrint c = not (isControl c) +isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f' +isPrint c = not (isControl c) -- The upper case ISO characters have the multiplication sign dumped -- randomly in the middle of the range. Go figure. -isUpper c = c >= 'A' && c <= 'Z' || +isUpper c = c >= 'A' && c <= 'Z' || c >= '\xC0' && c <= '\xD6' || c >= '\xD8' && c <= '\xDE' -- The lower case ISO characters have the division sign dumped -- randomly in the middle of the range. Go figure. -isLower c = c >= 'a' && c <= 'z' || +isLower c = c >= 'a' && c <= 'z' || c >= '\xDF' && c <= '\xF6' || c >= '\xF8' && c <= '\xFF' -isAlpha c = isLower c || isUpper c -isDigit c = c >= '0' && c <= '9' -isAlphaNum c = isAlpha c || isDigit c +isAlpha c = isLower c || isUpper c +isAlphaNum c = isAlpha c || isDigit c -- Case-changing operations @@ -206,7 +207,7 @@ toUpper c@(C# c#) | isAsciiLower c = C# (chr# (ord# c# -# 32#)) | isAscii c = c -- fall-through to the slower stuff. - | isLower c && c /= '\xDF' && c /= '\xFF' + | isLower c && c /= '\xDF' && c /= '\xFF' = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A') | otherwise = c @@ -215,8 +216,8 @@ toUpper c@(C# c#) toLower c@(C# c#) | isAsciiUpper c = C# (chr# (ord# c# +# 32#)) | isAscii c = c - | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a') - | otherwise = c + | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a') + | otherwise = c #endif