extra/rosetta-code/arithmetic-evaluation/arithmetic-evaluation.factor

   1 USING: accessors kernel locals math math.parser peg.ebnf ;
   2 IN: rosetta-code.arithmetic-evaluation
   3
   4 ! http://rosettacode.org/wiki/Arithmetic_evaluation
   5
   6 ! Create a program which parses and evaluates arithmetic
   7 ! expressions.
   8
   9 ! Requirements
  10
  11 ! * An abstract-syntax tree (AST) for the expression must be
  12 !   created from parsing the input.
  13 ! * The AST must be used in evaluation, also, so the input may not
  14 !   be directly evaluated (e.g. by calling eval or a similar
  15 !   language feature.)
  16 ! * The expression will be a string or list of symbols like
  17 !   "(1+3)*7".
  18 ! * The four symbols + - * / must be supported as binary operators
  19 !   with conventional precedence rules.
  20 ! * Precedence-control parentheses must also be supported.
  21
  22 ! Note
  23
  24 ! For those who don't remember, mathematical precedence is as
  25 ! follows:
  26
  27 ! * Parentheses
  28 ! * Multiplication/Division (left to right)
  29 ! * Addition/Subtraction (left to right)
  30
  31 TUPLE: operator left right ;
  32 TUPLE: add < operator ;   C: <add> add
  33 TUPLE: sub < operator ;   C: <sub> sub
  34 TUPLE: mul < operator ;   C: <mul> mul
  35 TUPLE: div < operator ;   C: <div> div
  36
  37 EBNF: expr-ast
  38 spaces   = [\n\t ]*
  39 digit    = [0-9]
  40 number   = (digit)+                         => [[ string>number ]]
  41
  42 value    =   spaces number:n                => [[ n ]]
  43            | spaces "(" exp:e spaces ")"    => [[ e ]]
  44
  45 fac      =   fac:a spaces "*" value:b       => [[ a b <mul> ]]
  46            | fac:a spaces "/" value:b       => [[ a b <div> ]]
  47            | value
  48
  49 exp      =   exp:a spaces "+" fac:b         => [[ a b <add> ]]
  50            | exp:a spaces "-" fac:b         => [[ a b <sub> ]]
  51            | fac
  52
  53 main     = exp:e spaces !(.)                => [[ e ]]
  54 ;EBNF
  55
  56 GENERIC: eval-ast ( ast -- result )
  57
  58 M: number eval-ast ;
  59
  60 : recursive-eval ( ast -- left-result right-result )
  61     [ left>> eval-ast ] [ right>> eval-ast ] bi ;
  62
  63 M: add eval-ast recursive-eval + ;
  64 M: sub eval-ast recursive-eval - ;
  65 M: mul eval-ast recursive-eval * ;
  66 M: div eval-ast recursive-eval / ;
  67
  68 : evaluate ( string -- result )
  69     expr-ast eval-ast ;