fork(1) download
copy 
  1.  
  2. wordlist constant prefix-wl  \ словарь префиксных операторов
  3. wordlist constant infix-wl  \ словарь инфиксных операторов
  4.  
  5. \ вспомогательные слова для работы с контекстом поиска
  6. : set-top  ( wid -- )
  7.     >r get-order nip r> swap set-order ;
  8. : infix  infix-wl set-top ;
  9. : prefix  prefix-wl set-top ;
  10.  
  11. : create-in-wordlist  ( wid "name" -- )
  12.     \ создать определение в определённом словаре
  13.     get-current swap set-current
  14.     create
  15.     set-current ;
  16.  
  17. : eval-word  ( i*x c-addr -- j*x )
  18.     \ как evaluate, но для одного слова и в контексте исходной строки
  19.     find if
  20.         state @  if  compile,  else  execute  then
  21.     else
  22.         count evaluate
  23.     then ;
  24.  
  25. : prefix:  ( xt "name" -- )
  26.     \ создать для xt определение в префиксном словаре
  27.     prefix-wl create-in-wordlist ,
  28.     does>
  29.         @ >r
  30.         bl word eval-word
  31.         r> execute
  32.         infix ;
  33.  
  34. : infix:  ( xt "name" -- )
  35.     \ создать для xt определение в инфиксном словаре
  36.     infix-wl create-in-wordlist ,
  37.     does>
  38.         @ >r
  39.         prefix
  40.         bl word eval-word
  41.         r> execute ;
  42.  
  43. ' - infix: -
  44. ' negate prefix: -
  45.  
  46. also infix
  47.  
  48. \ test
  49. 3 - - 0 - - 5 .  \ 8
  50.  
  51.  
Success #stdin #stdout 0s 4336KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
8
https://ideone.com/Ys1f2d
language:
Forth (gforth 0.7.3)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!