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