GHC/Unicode.hsc

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  GHC.Unicde
   5 -- Copyright   :  (c) The University of Glasgow, 2003
   6 -- License     :  see libraries/base/LICENSE
   7 --
   8 -- Maintainer  :  cvs-ghc@haskell.org
   9 -- Stability   :  internal
  10 -- Portability :  non-portable (GHC extensions)
  11 --
  12 -- Implementations for the character predicates (isLower, isUpper, etc.)
  13 -- and the conversions (toUpper, toLower).  The implementation uses
  14 -- libunicode on Unix systems if that is available.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module GHC.Unicode (
  19     isAscii, isLatin1, isControl,
  20     isAsciiUpper, isAsciiLower,
  21     isPrint, isSpace,  isUpper,
  22     isLower, isAlpha,  isDigit,
  23     isOctDigit, isHexDigit, isAlphaNum,
  24     toUpper, toLower,
  25   ) where
  26
  27 import GHC.Base
  28 import GHC.Real  (fromIntegral)
  29 import GHC.Int
  30 import GHC.Word
  31 import GHC.Num   (fromInteger)
  32
  33 #include "config.h"
  34
  35 isAscii, isLatin1, isAsciiUpper, isAsciiLower :: Char -> Bool
  36 isAscii c               =  c <  '\x80'
  37 isLatin1 c              =  c <= '\xff'
  38 isAsciiLower c          =  c >= 'a' && c <= 'z'
  39 isAsciiUpper c          =  c >= 'A' && c <= 'Z'
  40
  41 isControl, isPrint, isSpace, isUpper,
  42  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum
  43  :: Char -> Bool
  44
  45 isOctDigit c            =  c >= '0' && c <= '7'
  46 isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
  47                                         c >= 'a' && c <= 'f'
  48
  49 -- -----------------------------------------------------------------------------
  50 -- Win32 implementation
  51
  52 #if defined(HAVE_WCTYPE_H) || mingw32_TARGET_OS
  53
  54 -- Use the wide-char classification functions if available.  Glibc
  55 -- seems to implement these properly, even for chars > 0xffff, as long
  56 -- as you call setlocale() to set the locale to something other than
  57 -- "C".  Therefore, we call setlocale() in hs_init().
  58
  59 -- Win32 uses UTF-16, so presumably the system-supplied iswlower() and
  60 -- friends won't work properly with characters > 0xffff.  These
  61 -- characters are represented as surrogate pairs in UTF-16.
  62
  63 type WInt = (#type wint_t)
  64 type CInt = (#type int)
  65
  66 isDigit    c = iswdigit (fromIntegral (ord c)) /= 0
  67 isAlpha    c = iswalpha (fromIntegral (ord c)) /= 0
  68 isAlphaNum c = iswalnum (fromIntegral (ord c)) /= 0
  69 isSpace    c = iswspace (fromIntegral (ord c)) /= 0
  70 isControl  c = iswcntrl (fromIntegral (ord c)) /= 0
  71 isPrint    c = iswprint (fromIntegral (ord c)) /= 0
  72 isUpper    c = iswupper (fromIntegral (ord c)) /= 0
  73 isLower    c = iswlower (fromIntegral (ord c)) /= 0
  74
  75 toLower c = chr (fromIntegral (towlower (fromIntegral (ord c))))
  76 toUpper c = chr (fromIntegral (towupper (fromIntegral (ord c))))
  77
  78 foreign import ccall unsafe "iswdigit"
  79   iswdigit :: WInt -> CInt
  80
  81 foreign import ccall unsafe "iswalpha"
  82   iswalpha :: WInt -> CInt
  83
  84 foreign import ccall unsafe "iswalnum"
  85   iswalnum :: WInt -> CInt
  86
  87 foreign import ccall unsafe "iswcntrl"
  88   iswcntrl :: WInt -> CInt
  89
  90 foreign import ccall unsafe "iswspace"
  91   iswspace :: WInt -> CInt
  92
  93 foreign import ccall unsafe "iswprint"
  94   iswprint :: WInt -> CInt
  95
  96 foreign import ccall unsafe "iswlower"
  97   iswlower :: WInt -> CInt
  98
  99 foreign import ccall unsafe "iswupper"
 100   iswupper :: WInt -> CInt
 101
 102 foreign import ccall unsafe "towlower"
 103   towlower :: WInt -> WInt
 104
 105 foreign import ccall unsafe "towupper"
 106   towupper :: WInt -> WInt
 107
 108 -- -----------------------------------------------------------------------------
 109 -- No libunicode, so fall back to the ASCII-only implementation
 110
 111 #else
 112
 113 isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
 114 isPrint c               =  not (isControl c)
 115
 116 -- isSpace includes non-breaking space
 117 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
 118 -- recursion with GHC.List elem
 119 isSpace c               =  c == ' '     ||
 120                            c == '\t'    ||
 121                            c == '\n'    ||
 122                            c == '\r'    ||
 123                            c == '\f'    ||
 124                            c == '\v'    ||
 125                            c == '\xa0'
 126
 127 -- The upper case ISO characters have the multiplication sign dumped
 128 -- randomly in the middle of the range.  Go figure.
 129 isUpper c               =  c >= 'A' && c <= 'Z' ||
 130                            c >= '\xC0' && c <= '\xD6' ||
 131                            c >= '\xD8' && c <= '\xDE'
 132 -- The lower case ISO characters have the division sign dumped
 133 -- randomly in the middle of the range.  Go figure.
 134 isLower c               =  c >= 'a' && c <= 'z' ||
 135                            c >= '\xDF' && c <= '\xF6' ||
 136                            c >= '\xF8' && c <= '\xFF'
 137
 138 isAlpha c               =  isLower c || isUpper c
 139 isDigit c               =  c >= '0' && c <= '9'
 140 isAlphaNum c            =  isAlpha c || isDigit c
 141
 142 -- Case-changing operations
 143
 144 toUpper, toLower        :: Char -> Char
 145 toUpper c@(C## c##)
 146   | isAsciiLower c    = C## (chr## (ord## c## -## 32##))
 147   | isAscii c         = c
 148     -- fall-through to the slower stuff.
 149   | isLower c   && c /= '\xDF' && c /= '\xFF'
 150   = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
 151   | otherwise
 152   = c
 153
 154
 155 toLower c@(C## c##)
 156   | isAsciiUpper c = C## (chr## (ord## c## +## 32##))
 157   | isAscii c      = c
 158   | isUpper c      = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
 159   | otherwise      =  c
 160
 161 #endif
 162