basis/regexp/classes/classes.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel math math.order symbols
   4 words regexp.utils unicode.categories combinators.short-circuit ;
   5 IN: regexp.classes
   6
   7 SINGLETONS: any-char any-char-no-nl
   8 letter-class LETTER-class Letter-class digit-class
   9 alpha-class non-newline-blank-class
  10 ascii-class punctuation-class java-printable-class blank-class
  11 control-character-class hex-digit-class java-blank-class c-identifier-class
  12 unmatchable-class terminator-class word-boundary-class ;
  13
  14 SINGLETONS: beginning-of-input beginning-of-line
  15 end-of-input end-of-line ;
  16
  17 MIXIN: node
  18 TUPLE: character-class-range from to ; INSTANCE: character-class-range node
  19
  20 GENERIC: class-member? ( obj class -- ? )
  21
  22 M: t class-member? ( obj class -- ? ) 2drop f ;
  23
  24 M: integer class-member? ( obj class -- ? ) 2drop f ;
  25
  26 M: character-class-range class-member? ( obj class -- ? )
  27     [ from>> ] [ to>> ] bi between? ;
  28
  29 M: any-char class-member? ( obj class -- ? )
  30     2drop t ;
  31
  32 M: any-char-no-nl class-member? ( obj class -- ? )
  33     drop CHAR: \n = not ;
  34
  35 M: letter-class class-member? ( obj class -- ? )
  36     drop letter? ;
  37
  38 M: LETTER-class class-member? ( obj class -- ? )
  39     drop LETTER? ;
  40
  41 M: Letter-class class-member? ( obj class -- ? )
  42     drop Letter? ;
  43
  44 M: ascii-class class-member? ( obj class -- ? )
  45     drop ascii? ;
  46
  47 M: digit-class class-member? ( obj class -- ? )
  48     drop digit? ;
  49
  50 M: c-identifier-class class-member? ( obj class -- ? )
  51     drop
  52     { [ digit? ] [ Letter? ] [ CHAR: _ = ] } 1|| ;
  53
  54 M: alpha-class class-member? ( obj class -- ? )
  55     drop alpha? ;
  56
  57 M: punctuation-class class-member? ( obj class -- ? )
  58     drop punct? ;
  59
  60 M: java-printable-class class-member? ( obj class -- ? )
  61     drop java-printable? ;
  62
  63 M: non-newline-blank-class class-member? ( obj class -- ? )
  64     drop { [ blank? ] [ CHAR: \n = not ] } 1&& ;
  65
  66 M: control-character-class class-member? ( obj class -- ? )
  67     drop control-char? ;
  68
  69 M: hex-digit-class class-member? ( obj class -- ? )
  70     drop hex-digit? ;
  71
  72 M: java-blank-class class-member? ( obj class -- ? )
  73     drop java-blank? ;
  74
  75 M: unmatchable-class class-member? ( obj class -- ? )
  76     2drop f ;
  77
  78 M: terminator-class class-member? ( obj class -- ? )
  79     drop {
  80         [ CHAR: \r = ]
  81         [ CHAR: \n = ]
  82         [ CHAR: \u000085 = ]
  83         [ CHAR: \u002028 = ]
  84         [ CHAR: \u002029 = ]
  85     } 1|| ;
  86
  87 M: beginning-of-line class-member? ( obj class -- ? )
  88     2drop f ;
  89
  90 M: end-of-line class-member? ( obj class -- ? )
  91     2drop f ;