( Forth to C name Translation rules  Rob Chapman  Apr 15, 1992 )

 RULE-SET translate
 RULE-SET character

HEX
( ==== String building queries: new string at HERE; chars on stack ==== )
: START?  ( -- f )  HERE 1 - C@ 0= ;
: END?  ( 0 \ [...] -- 0 \ [...] \ f )  DUP 0= ;
: MIDDLE?  ( -- f )  END? 0=  START? 0=  AND ;

translate RULES  ( from ruleset -- translated string )
{ Done. }[ RULES ]

( ==== Default rule ==== )
{ }{ parse string }

( ==== Word translation ==== )
{ CR }{ Done. _CR }
{ U> }{ Done. U_GREATER_THAN }
{ >  }{ Done. GREATER_THAN }
{ #> }{ Done. END_NUMBER_CONVERSION }
{ <# }{ Done. START_NUMBER_CONVERSION }
{ #  }{ Done. CONVERT_DIGIT }
{ #S }{ Done. CONVERT_NUMBER }
{ free }{ Done.  dp }
{ REBOOT }{ Done. main }
{ CASE }{ Done. _CASE }
{ DOT }{ Done. PIX }
{ default }{ _default }
{ FILE }{ OPEN }

( ==== For redefinitions ==== )
  YES VARIABLE prepend  ( set to no for no prepending )
  
: FILE_NAME  ( s -- )  prepend @
   IF  file.F HERE $!  -2 HERE C+!  HERE  " _" COUNT +$
       HERE SWAP COUNT +$  HERE  DUP C@ 1 + ALLOCATE  TUCK  OVER C@ 1 +  CMOVE
   ENDIF  inputq STUFF ;

{ VERSION }[ " VERSION" FILE_NAME ]
| { |[ " {" FILE_NAME  prepend @ 0=  IF  | parse string |  ENDIF ]
{ INIT }[ " INIT" FILE_NAME ]

( rules which might need integrating )
( { _file }{ _file_ } )
( { RESTORE-IO }{ use word restore_io } )
( { SETUP-IO }{ use word setup_io } )

( ==== Word to characters ==== )
{ parse string }[ HERE 0 C,  0  inputq PULL ]{ unzip }
{ unzip }[ DUP C@  TUCK +  SWAP  FOR  C@-  NEXT  DROP ]{ Char get }
{ Char }[ character RULES ]

character RULES
{ }[ inputq PULL  1 + C@  C, ]{ get }

{ Done. }[ translate RULES ]{ Done. }

( ==== Sub_words_of_a_word ==== )
{ ?_ }[ START? 0=  IF  HERE 1 - C@  ` _ XOR  IF  ` _ C,  ENDIF  ENDIF ]
{ _? }[   END? 0=  IF  ` _ C,  ENDIF ]

{ add string }[ COUNT  FOR  C@+ SWAP C,  NEXT  DROP ]
{ use word }[ inputq PULL ]{ ?_ add string _?  get }
{ use word _ }{ ?_  get }

( ==== Character parser ==== )
{ get   }[ ?DUP  IF  { stuff char }  ELSE  { end of string }  ENDIF ]
{ stuff char }[ 1  HERE  C!+  C!-  inputq STUFF ]
{ end of string }[ HERE OVER - 1 -  OVER C!  inputq STUFF ]{ Done. }

( ==== Character translations ==== )
{ 0 }[ START?  IF  { ZERO }   ELSE  { 0 }  ENDIF ]{ use word }
{ 1 }[ START?  IF  { ONE }    ELSE  { 1 }  ENDIF ]{ use word }
{ 2 }[ START?  IF  { TWO }    ELSE  { 2 }  ENDIF ]{ use word }
{ 3 }[ START?  IF  { THREE }  ELSE  { 3 }  ENDIF ]{ use word }
{ 4 }[ START?  IF  { FOUR }   ELSE  { 4 }  ENDIF ]{ use word }
{ 5 }[ START?  IF  { FIVE }   ELSE  { 5 }  ENDIF ]{ use word }
{ 6 }[ START?  IF  { SIX }    ELSE  { 6 }  ENDIF ]{ use word }
{ 7 }[ START?  IF  { SEVEN }  ELSE  { 7 }  ENDIF ]{ use word }
{ 8 }[ START?  IF  { EIGHT }  ELSE  { 8 }  ENDIF ]{ use word }
{ 9 }[ START?  IF  { NINE }   ELSE  { 9 }  ENDIF ]{ use word }
{ ? }[ END?  IF { QUERY } ELSE { QUESTION } ENDIF ]{ use word }
{ > }[ END?  IF  { FROM }  ELSE  { TO }  ENDIF ]{ use word }
{ @ }{ use word FETCH }
{ ! }{ use word STORE }
{ * }{ use word STAR }
{ / }{ use word SLASH }
{ + }{ use word PLUS }
{ - }[ MIDDLE?  IF  { _ }  ELSE  { MINUS }  ENDIF ]{ use word }
{ < }{ use word LESS_THAN }
{ = }{ use word EQUALS }
{ ( }{ use word COMMENT }
{ [ }{ use word LEFT_SQUARE_BRACKET }
{ ] }{ use word RIGHT_SQUARE_BRACKET }
{ . }{ use word DOT }
{ , }{ use word COMMA }
{ ' }{ use word TICK }
{ " }{ use word QUOTE }
{ : }{ use word COLON }
{ ; }{ use word SEMI_COLON }
{ # }{ use word NUMBER }
{ $ }{ use word DOLLARS }
{ % }{ use word PERCENT }
{ ^ }{ use word CARAT }
{ & }{ use word AMPERSAND }
{ ~ }{ use word TILDE }
{ | }{ use word VERTICAL_BAR }
{ \ }{ use word BACKSLASH }
{ ` }{ use word BACK_TICK }
{ { }{ use word LEFT_CURLEY_BRACKET }
| } || use word RIGHT_CURLEY_BRACKET |
