extra/successor/successor.factor

   1 ! Copyright (C) 2011 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: ascii combinators combinators.short-circuit kernel
   5 math sequences ;
   6
   7 IN: successor
   8
   9 <PRIVATE
  10
  11 : carry ( elt last first -- ? elt' )
  12     '[ _ > dup _ ] keep ? ;
  13
  14 : next-digit ( ch -- ? ch' )
  15     1 + CHAR: 9 CHAR: 0 carry ;
  16
  17 : next-letter ( ch -- ? ch' )
  18     [ ch>lower 1 + CHAR: z CHAR: a carry ] [ LETTER? ] bi
  19     [ ch>upper ] when ;
  20
  21 : next-char ( ch -- ? ch' )
  22     {
  23         { [ dup digit?  ] [ next-digit  ] }
  24         { [ dup Letter? ] [ next-letter ] }
  25         [ t swap ]
  26     } cond ;
  27
  28 : map-until ( seq quot: ( elt -- ? elt' ) -- seq' ? )
  29     [ t 0 pick length '[ 2dup _ < and ] ] dip '[
  30         nip [ over _ change-nth ] keep 1 +
  31     ] while drop ; inline
  32
  33 : alphanum? ( ch -- ? )
  34     { [ Letter? ] [ digit? ] } 1|| ;
  35
  36 PRIVATE>
  37
  38 : successor ( str -- str' )
  39     dup empty? [
  40         dup [ alphanum? ] any? [
  41             reverse [ next-char ] map-until
  42             [ dup last suffix ] when reverse
  43         ] [
  44             dup length 1 - over [ 1 + ] change-nth
  45         ] if
  46     ] unless ;