basis/tr/tr.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: ascii assocs byte-arrays fry hints kernel lexer math
   4 math.order parser sequences sequences.private strings summary
   5 words ;
   6 IN: tr
   7
   8 ERROR: bad-tr ;
   9
  10 M: bad-tr summary
  11     drop "TR: can only be used with ASCII characters" ;
  12
  13 <PRIVATE
  14
  15 : tr-nth ( n mapping -- ch ) nth-unsafe 127 bitand ; inline
  16
  17 : check-tr ( from to -- )
  18     [ [ ascii? ] all? ] both? [ bad-tr ] unless ;
  19
  20 : compute-tr ( quot from to -- mapping )
  21     [ 128 <iota> ] 3dip zip
  22     '[ [ _ call( x -- y ) _ at ] keep or ] B{ } map-as ; inline
  23
  24 : tr-hints ( word -- )
  25     { { byte-array } { string } } set-specializer ;
  26
  27 : create-tr ( token -- word )
  28     create-word-in dup tr-hints ;
  29
  30 : tr-quot ( mapping -- quot )
  31     '[ [ dup ascii? [ _ tr-nth ] when ] map ] ;
  32
  33 : define-tr ( word mapping -- )
  34     tr-quot ( seq -- translated ) define-declared ;
  35
  36 : fast-tr-quot ( mapping -- quot )
  37     '[ [ _ tr-nth ] map! drop ] ;
  38
  39 : define-fast-tr ( word mapping -- )
  40     fast-tr-quot ( seq -- ) define-declared ;
  41
  42 PRIVATE>
  43
  44 SYNTAX: TR:
  45     scan-token parse-definition
  46     unclip-last [ unclip-last ] dip compute-tr
  47     [ check-tr ]
  48     [ [ create-tr ] dip define-tr ]
  49     [ [ "-fast" append create-tr ] dip define-fast-tr ] 2tri ;