extra/base36/base36.factor

   1 ! Copyright (C) 2020 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: base64.private byte-arrays endian kernel kernel.private
   5 literals math math.functions sequences ;
   6
   7 IN: base36
   8
   9 ERROR: malformed-base36 ;
  10
  11 <PRIVATE
  12
  13 <<
  14 CONSTANT: alphabet $[
  15     "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  16     >byte-array
  17 ]
  18 >>
  19
  20 PRIVATE>
  21
  22 : ch>base36 ( ch -- ch )
  23     alphabet nth ; inline
  24
  25 : base36>ch ( ch -- ch )
  26     $[ alphabet alphabet-inverse ] nth
  27     [ malformed-base36 ] unless* { fixnum } declare ; inline
  28
  29 :: >base36 ( seq -- base36 )
  30     BV{ } clone :> accum
  31     seq [ zero? not ] find [ drop seq length ] unless :> i
  32     seq i tail-slice be>
  33     [ 36 /mod ch>base36 accum push ] until-zero
  34     i alphabet first '[ _ accum push ] times
  35     accum reverse! B{ } like ;
  36
  37 :: base36> ( base36 -- seq )
  38     BV{ } clone :> accum
  39     base36 alphabet first '[ _ = not ] find
  40     [ drop base36 length ] unless :> i
  41     0 base36 [ [ 36 * ] dip base36>ch + ] i each-from
  42     [ 256 /mod accum push ] until-zero
  43     i [ 0 accum push ] times
  44     accum reverse! B{ } like ;
  45
  46 : n>base36 ( n -- base36 )
  47     dup log2 1 + 8 / ceiling >integer >be >base36 ;
  48
  49 : base36>n ( base36 -- n )
  50     base36> be> ;