library/platform/jvm/regexp.factor

   1 ! :folding=indent:collapseFolds=1:
   2
   3 ! $Id$
   4 !
   5 ! Copyright (C) 2003, 2004 Slava Pestov.
   6 !
   7 ! Redistribution and use in source and binary forms, with or without
   8 ! modification, are permitted provided that the following conditions are met:
   9 !
  10 ! 1. Redistributions of source code must retain the above copyright notice,
  11 !    this list of conditions and the following disclaimer.
  12 !
  13 ! 2. Redistributions in binary form must reproduce the above copyright notice,
  14 !    this list of conditions and the following disclaimer in the documentation
  15 !    and/or other materials provided with the distribution.
  16 !
  17 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  18 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  19 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  20 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  21 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  22 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  23 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  24 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  25 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  26 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27
  28 IN: regexp
  29 USE: arithmetic
  30 USE: combinators
  31 USE: kernel
  32 USE: logic
  33 USE: lists
  34 USE: stack
  35
  36 : <regex> ( pattern -- regex )
  37     ! Compile the regex, if its not already compiled.
  38     dup "java.util.regex.Pattern" is not [
  39         [ "java.lang.String" ]
  40         "java.util.regex.Pattern" "compile"
  41         jinvoke-static
  42     ] when ;
  43
  44 : <matcher> ( string pattern -- matcher )
  45     [ "java.lang.CharSequence" ]
  46     "java.util.regex.Pattern" "matcher"
  47     jinvoke ;
  48
  49 : re-matches* ( matcher -- boolean )
  50     [ ] "java.util.regex.Matcher" "matches"
  51     jinvoke ;
  52
  53 : re-matches ( input regex -- boolean )
  54     <regex> <matcher> re-matches* ;
  55
  56 : [re-matches] ( matcher code -- boolean )
  57     ! If the matcher's re-matches* function returns true,
  58     ! evaluate the code with the matcher at the top of the
  59     ! stack. Otherwise, pop the matcher off the stack and
  60     ! push f.
  61     [ dup re-matches* ] dip [ drop f ] ifte ;
  62
  63 : re-replace* ( replace matcher -- string )
  64     [ "java.lang.String" ] "java.util.regex.Matcher"
  65     "replaceAll" jinvoke ;
  66
  67 : re-replace ( input regex replace -- string )
  68     ! Replaces all occurrences of the regex in the input string
  69     ! with the replace string.
  70     -rot <regex> <matcher> re-replace* ;
  71
  72 : re-split ( string split -- list )
  73     <regex> [ "java.lang.CharSequence" ]
  74     "java.util.regex.Pattern" "split" jinvoke array>list ;
  75
  76 : group ( index match -- )
  77     [ "int" ] "java.util.regex.Matcher" "group"
  78     jinvoke ;
  79
  80 : group-count ( matcher -- count )
  81     [ ] "java.util.regex.Matcher" "groupCount"
  82     jinvoke ;
  83
  84 : groups* ( matcher -- list )
  85     [
  86         [
  87             dup group-count [
  88                 succ over group swap
  89             ] times* drop
  90         ] cons expand
  91     ] [re-matches] ;
  92
  93 : groups ( input regex -- list )
  94     <regex> <matcher> groups* ;
  95
  96 : group1 ( string regex -- string )
  97     groups dup [ car ] when ;
  98
  99 : groups/t ( string re -- groups )
 100     dup t = [
 101         nip
 102     ] [
 103         groups
 104     ] ifte ;
 105
 106 : re-cond ( string alist -- )
 107     dup [
 108         unswons [ over ] dip ( string tail string head )
 109         uncons [ groups/t ] dip ( string tail groups code )
 110         over [
 111             2nip call
 112         ] [
 113             2drop re-cond
 114         ] ifte
 115     ] [
 116         2drop
 117     ] ifte ;