basis/tr/tr.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: byte-arrays strings sequences sequences.private
   4 fry kernel words parser lexer assocs math.order ;
   5 IN: tr
   6
   7 <PRIVATE
   8
   9 : compute-tr ( quot from to -- mapping )
  10     zip [ 256 ] 2dip '[ [ @ _ at ] keep or ] B{ } map-as ; inline
  11
  12 : tr-hints ( word -- )
  13     { { byte-array } { string } } "specializer" set-word-prop ;
  14
  15 : create-tr ( token -- word )
  16     create-in dup tr-hints ;
  17
  18 : tr-quot ( mapping -- quot )
  19     '[ [ dup 0 255 between? [ _ nth-unsafe ] when ] map ] ;
  20
  21 : define-tr ( word mapping -- )
  22     tr-quot (( seq -- translated )) define-declared ;
  23
  24 : fast-tr-quot ( mapping -- quot )
  25     '[ [ _ nth-unsafe ] change-each ] ;
  26
  27 : define-fast-tr ( word mapping -- )
  28     fast-tr-quot (( seq -- )) define-declared ;
  29
  30 PRIVATE>
  31
  32 : TR:
  33     scan parse-definition
  34     unclip-last [ unclip-last ] dip compute-tr
  35     [ [ create-tr ] dip define-tr ]
  36     [ [ "-fast" append create-tr ] dip define-fast-tr ] 2bi ;
  37     parsing