extra/rpn/rpn.factor

   1 ! Copyright (C) 2009 Slava Pestov
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators io kernel lists math math.parser
   4 sequences splitting ;
   5 IN: rpn
   6
   7 SINGLETONS: add-insn sub-insn mul-insn div-insn ;
   8 TUPLE: push-insn value ;
   9
  10 GENERIC: eval-insn ( stack insn -- stack )
  11
  12 : binary-op ( stack quot: ( x y -- z ) -- stack )
  13     [ uncons uncons swapd ] dip dip cons ; inline
  14
  15 M: add-insn eval-insn drop [ + ] binary-op ;
  16 M: sub-insn eval-insn drop [ - ] binary-op ;
  17 M: mul-insn eval-insn drop [ * ] binary-op ;
  18 M: div-insn eval-insn drop [ / ] binary-op ;
  19 M: push-insn eval-insn value>> swons ;
  20
  21 : rpn-tokenize ( string -- string' )
  22     split-words harvest sequence>list ;
  23
  24 : rpn-parse ( string -- tokens )
  25     rpn-tokenize [
  26         {
  27             { "+" [ add-insn ] }
  28             { "-" [ sub-insn ] }
  29             { "*" [ mul-insn ] }
  30             { "/" [ div-insn ] }
  31             [ string>number push-insn boa ]
  32         } case
  33     ] lmap ;
  34
  35 : print-stack ( list -- )
  36     [ number>string print ] leach ;
  37
  38 : rpn-eval ( tokens -- stack )
  39     nil [ eval-insn ] foldl ;
  40
  41 : rpn ( -- )
  42     "RPN> " write flush
  43     readln [ rpn-parse rpn-eval print-stack rpn ] when* ;
  44
  45 MAIN: rpn