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