basis/xml/char-classes/char-classes.factor

   1 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences unicode.categories.syntax math math.order
   4 combinators hints combinators.short-circuit ;
   5 IN: xml.char-classes
   6
   7 CATEGORY: 1.0name-start
   8     Ll Lu Lo Lt Nl | {
   9         [ 0x2BB 0x2C1 between? ]
  10         [ "\u000559\u0006E5\u0006E6_:" member? ]
  11     } 1|| ;
  12
  13 CATEGORY: 1.0name-char
  14     Ll Lu Lo Lt Nl Mc Me Mn Lm Nd |
  15     "_-.\u000387:" member? ;
  16
  17 CATEGORY: 1.1name-start
  18     Ll Lu Lo Lm Nl |
  19     "_:" member? ;
  20
  21 CATEGORY: 1.1name-char
  22     Ll Lu Lo Lm Nl Mc Mn Nd Pc Cf |
  23     "_-.\u0000b7:" member? ;
  24
  25 : name-start? ( 1.0? char -- ? )
  26     swap [ 1.0name-start? ] [ 1.1name-start? ] if ;
  27
  28 : name-char? ( 1.0? char -- ? )
  29     swap [ 1.0name-char? ] [ 1.1name-char? ] if ;
  30
  31 HINTS: name-start? { object fixnum } ;
  32 HINTS: name-char? { object fixnum } ;
  33
  34 <PRIVATE
  35
  36 : 1.0-text? ( char -- ? )
  37     ! 1.0:
  38     ! #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
  39     {
  40         [ 0x20 0xD7FF between? ]
  41         [ "\t\r\n" member? ]
  42         [ 0xE000 0xFFFD between? ]
  43         [ 0x10000 0x10FFFF between? ]
  44     } 1|| ; inline
  45
  46 : 1.1-text? ( char -- ? )
  47     ! 1.1:
  48     ! [#x1-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
  49     {
  50         [ 0x1 0xD7FF between? ]
  51         [ 0xE000 0xFFFD between? ]
  52         [ 0x10000 0x10FFFF between? ]
  53     } 1|| ; inline
  54
  55 PRIVATE>
  56
  57 : text? ( 1.0? char -- ? )
  58     swap [ 1.0-text? ] [ 1.1-text? ] if ;
  59
  60 HINTS: text? { object fixnum } ;