ghc/compiler/parser/Ctype.lhs

   1 Character classification
   2
   3 \begin{code}
   4 {-# OPTIONS -#include "hs_ctype.h" #-}
   5
   6 module Ctype
   7         ( is_ident      -- Char# -> Bool
   8         , is_symbol     -- Char# -> Bool
   9         , is_any        -- Char# -> Bool
  10         , is_space      -- Char# -> Bool
  11         , is_lower      -- Char# -> Bool
  12         , is_upper      -- Char# -> Bool
  13         , is_digit      -- Char# -> Bool
  14         , is_string     -- Char# -> Bool
  15         ) where
  16 \end{code}
  17
  18 \begin{code}
  19 import Bits     ( Bits((.&.)) )
  20 import Int      ( Int32 )
  21 import Addr
  22 import Char     ( ord )
  23 import GlaExts  ( Char#, Char(..) )
  24 \end{code}
  25
  26 #define NO_CDECLS
  27 #include <hs_ctype.h>
  28 \end{code}
  29
  30 The predicates below look costly, but aren't, GHC+GCC do a great job
  31 at the big case below.
  32
  33 \begin{code}
  34 {-# INLINE is_ctype #-}
  35 is_ctype :: Int -> Char# -> Bool
  36 is_ctype mask c = (fromIntegral (charType (C# c)) .&. fromIntegral mask) /= (0::Int32)
  37
  38 cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit, cString :: Int
  39 cIdent  =  C_Ident  :: Int
  40 cSymbol =  C_Symbol :: Int
  41 cAny    =  C_Any    :: Int
  42 cSpace  =  C_Space  :: Int
  43 cLower  =  C_Lower  :: Int
  44 cUpper  =  C_Upper  :: Int
  45 cDigit  =  C_Digit  :: Int
  46 cString =  C_String :: Int
  47
  48 is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit, is_string :: Char# -> Bool
  49 is_ident  = is_ctype cIdent
  50 is_symbol = is_ctype cSymbol
  51 is_any    = is_ctype cAny
  52 is_space  = is_ctype cSpace
  53 is_lower  = is_ctype cLower
  54 is_upper  = is_ctype cUpper
  55 is_digit  = is_ctype cDigit
  56 is_string = is_ctype cString
  57
  58 foreign label "hs_char_types" hs_char_types :: Addr
  59
  60 charType :: Char -> Int
  61 charType c = ord (indexCharOffAddr hs_char_types (ord c))
  62 \end{code}