extra/base16/base16.factor

   1 ! Copyright (C) 2019 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: base64.private byte-arrays combinators io
   4 io.encodings.binary io.streams.byte-array kernel kernel.private
   5 literals math namespaces sequences ;
   6 IN: base16
   7
   8 ERROR: malformed-base16 ;
   9
  10 ! XXX: Optional handle lower-case input
  11
  12 <PRIVATE
  13
  14 <<
  15 CONSTANT: alphabet $[ "0123456789ABCDEF" >byte-array ]
  16 >>
  17
  18 : ch>base16 ( ch -- ch )
  19     alphabet nth ; inline
  20
  21 : base16>ch ( ch -- ch )
  22     $[ alphabet alphabet-inverse ] nth
  23     [ malformed-base16 ] unless* { fixnum } declare ; inline
  24
  25 :: (encode-base16) ( stream -- )
  26     stream stream-read1 [
  27         16 /mod [ ch>base16 write1 ] bi@
  28         stream (encode-base16)
  29     ] when* ;
  30
  31 PRIVATE>
  32
  33 : encode-base16 ( -- )
  34     input-stream get (encode-base16) ;
  35
  36 <PRIVATE
  37
  38 : decode2 ( seq -- n )
  39     first2 [ base16>ch ] bi@ [ 16 * ] [ + ] bi* ;
  40
  41 :: (decode-base16) ( stream -- )
  42     2 stream stream-read dup length {
  43         { 0 [ drop ] }
  44         { 2 [ decode2 write1 stream (decode-base16) ] }
  45         [ malformed-base16 ]
  46     } case ;
  47
  48 PRIVATE>
  49
  50 : decode-base16 ( -- )
  51     input-stream get (decode-base16) ;
  52
  53 : >base16 ( seq -- base16 )
  54     binary [ binary [ encode-base16 ] with-byte-reader ] with-byte-writer ;
  55
  56 : base16> ( base16 -- seq )
  57     binary [ binary [ decode-base16 ] with-byte-reader ] with-byte-writer ;