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 ascii
   4 fry kernel words parser lexer assocs math math.order summary ;
   5 IN: tr
   6
   7 ERROR: bad-tr ;
   8
   9 M: bad-tr summary
  10     drop "TR: can only be used with ASCII characters" ;
  11
  12 <PRIVATE
  13
  14 : tr-nth ( n mapping -- ch ) nth-unsafe 127 bitand ; inline
  15
  16 : check-tr ( from to -- )
  17     [ [ ascii? ] all? ] both? [ bad-tr ] unless ;
  18
  19 : compute-tr ( quot from to -- mapping )
  20     zip [ 128 ] 2dip '[ [ @ _ at ] keep or ] B{ } map-as ; inline
  21
  22 : tr-hints ( word -- )
  23     { { byte-array } { string } } "specializer" set-word-prop ;
  24
  25 : create-tr ( token -- word )
  26     create-in dup tr-hints ;
  27
  28 : tr-quot ( mapping -- quot )
  29     '[ [ dup ascii? [ _ tr-nth ] when ] map ] ;
  30
  31 : define-tr ( word mapping -- )
  32     tr-quot (( seq -- translated )) define-declared ;
  33
  34 : fast-tr-quot ( mapping -- quot )
  35     '[ [ _ tr-nth ] change-each ] ;
  36
  37 : define-fast-tr ( word mapping -- )
  38     fast-tr-quot (( seq -- )) define-declared ;
  39
  40 PRIVATE>
  41
  42 : TR:
  43     scan parse-definition
  44     unclip-last [ unclip-last ] dip compute-tr
  45     [ check-tr ]
  46     [ [ create-tr ] dip define-tr ]
  47     [ [ "-fast" append create-tr ] dip define-fast-tr ] 2tri ;
  48     parsing