reverse_polish_notation.arr

#lang pyret

data CalcOp:
  | push-op(n :: Number)
  | bin-op(operator :: String)
  | un-op(operator :: String)
end

fun first-some(l :: List<(-> Option)>) -> Option:
  doc: "search for the first non-none result in a list of lambdas"
  cases(List) l:
    | empty => none
    | link(foo, rest) => 
      block: 
        res = foo()
        ask:
          | is-some(res) then: res
          | otherwise: first-some(rest)
        end
      end
  end
where:
  first-some([list: {(): some(2)}, {(): some(3)}]) is some(2)
  first-some([list: {(): some(2)}, {(): none}]) is some(2)
  first-some([list: {(): none}, {(): some(3)}]) is some(3)
  first-some([list: {(): none}, {(): none}]) is none
end

fun try-parse-calc-op(s :: String) -> Option<CalcOp>:
  doc: "parses input, returning a some(AST node) if parsing is success, and none otherwise"
  first-some(
    [list:
      {(): string-to-number(s).and-then(push-op)},
      {(): [list: "+", "-", "*", "/", "%"].find(string-equal(_, s)).and-then(bin-op)},
      {(): [list: "sin", "cos", "sqrt"].find(string-equal(_, s)).and-then(un-op)}
    ]
  )
where:
  try-parse-calc-op("-10") is some(push-op(-10))
  try-parse-calc-op("1/2") is some(push-op(1/2))
  try-parse-calc-op("0.1") is some(push-op(0.1))
  try-parse-calc-op("+") is some(bin-op("+"))
  try-parse-calc-op("-") is some(bin-op("-"))
  try-parse-calc-op("*") is some(bin-op("*"))
  try-parse-calc-op("/") is some(bin-op("/"))
  try-parse-calc-op("%") is some(bin-op("%"))
  try-parse-calc-op("cos") is some(un-op("cos"))
  try-parse-calc-op("sqrt") is some(un-op("sqrt"))
  try-parse-calc-op("pow") is none
end

fun parse-reverse-polish-notation(s :: String) -> List<CalcOp>:
  doc: "parses input, returning a list of calc operations, skipping anything incorrect on the way"
  for foldr(acc from [list:], sub-str from string-split-all(s, " ")):
    try-parse-calc-op(sub-str).and-then(push(acc, _)).or-else(acc)
  end
where:
  parse-reverse-polish-notation("2 sqrt") is [list: push-op(2), un-op("sqrt")]
  parse-reverse-polish-notation("2 2 +") is [list: push-op(2), push-op(2), bin-op("+")]
  parse-reverse-polish-notation("2 some-incorrect-text 2 ?") is [list: push-op(2), push-op(2)]
end

fun eval-push(stack :: List<Number>, n :: Number) -> List<Number>:
  doc: "returns a new copy of a stack with n connected to it's head"
  push(stack, n) 
end
  
fun eval-unary(stack :: List<Number>, op :: String) -> List<Number>:
  doc: 
  ```
  takes an op code and a stack, and if stack contains at least one value, takes this value
  and applies operation on it, returning a new copy of a stack without an operand, and with 
  the result of an operation connected to it's head. In the case when operation is unknown, 
  just returns an original stack
  ```
  cases(List<Number>) stack:
    | empty => stack
    | link(operand, st) =>
      ask:
        | op == "sin" then: push(st, num-sin(operand))
        | op == "cos" then: push(st, num-cos(operand))
        | op == "sqrt" then: push(st, num-sqrt(operand))
        | otherwise: stack
      end
  end
where:
  eval-unary([list: 5], "sin") is-roughly [list: num-sin(5)]
  eval-unary([list: 5], "cos") is-roughly [list: num-cos(5)]
  eval-unary([list: 5], "sqrt") is-roughly [list: num-sqrt(5)]
  eval-unary([list: 5], "sqr") is [list: 5]
  eval-unary(empty, "sin") is empty
end
  
fun eval-binary(stack :: List<Number>, op :: String) -> List<Number>:
  doc: 
  ```
  takes an op code and a stack, and if stack contains at least two values, takes these values
  and applies operation on them, returning a new copy of a stack without operands with the result 
  of an operation connected to it's head. In the case when operation is unknown, just returns an 
  original stack
  ```
  cases(List<Number>) stack:
    | empty => stack
    | link(scnd, st) =>
      cases(List<Number>) st:
        | empty => stack
        | link(fst, shadow st) =>
          ask:
            | op == "+" then: push(st, fst + scnd)
            | op == "-" then: push(st, fst - scnd)
            | op == "*" then: push(st, fst * scnd)
            | op == "/" then: push(st, fst / scnd)
            | op == "%" then: push(st, num-modulo(fst, scnd))
            | otherwise: stack
          end
      end
  end
where:
  eval-binary([list: 5, 7], "+") is [list: 12]
  eval-binary([list: 5, 7], "!") is [list: 5, 7]
  eval-binary([list: 5, 8, 22], "+") is [list: 13, 22]
  eval-binary(empty, "+") is empty
  eval-binary([list: 5], "+") is [list: 5]
end

fun eval-reverse-polish-notation(s :: String) -> Option<Number>:
  doc: 
  ```
  Parses reverse polish notation string, evaluates it while keeping results in a stack and 
  returns some(result) if stack is not empty, otherwise returns none. If the stack is too small 
  for execution of operation, the operation is skipped. If the operation is unknown, this operation 
  is also skipped
  ```
  res = for foldl(stack from empty, op from parse-reverse-polish-notation(s)):
    cases(CalcOp) op:
      | push-op(n) => eval-push(stack, n)
      | bin-op(operator) => eval-binary(stack, operator)
      | un-op(operator) => eval-unary(stack, operator)
    end
  end
  
  cases(List<Number>) res:
    | empty => none
    | link(top, rst) => some(top)
  end
where:
  eval-reverse-polish-notation("2 2 +") is some(4)
  eval-reverse-polish-notation("2 2 ?") is some(2)
  eval-reverse-polish-notation("2 2 2 + *") is some(8)
  eval-reverse-polish-notation("2/3 2/8 +") is some(11/12)
  eval-reverse-polish-notation("2 2 2 * -") is some(-2)
  eval-reverse-polish-notation("2 2 2 * @ -") is some(-2)
  eval-reverse-polish-notation("2 2 * 2 -") is some(2)
  eval-reverse-polish-notation("1") is some(1)
  eval-reverse-polish-notation("16 sqrt") is some(4)
  eval-reverse-polish-notation("") is none
end

fun format(fmt-str :: String, args :: List<String>) -> String block:
  doc: 
  ```
  takes an fmt-str and replaces all entrances of {0}, {1}, ... {args.length()} in it, 
  taking values from args
  ```
  
  var arg-id = 0
  var txt = fmt-str
  
  for each(arg from args) block:
    txt := string-replace(txt, "{" + num-to-string(arg-id) + "}", arg)
    arg-id := arg-id + 1
  end
  
  txt
where:
  format("{0} days without {1}", [list: "zero", "string format"]) is 
  "zero days without string format"
end

fun compile-reverse-polish-notation(s :: String) -> String block:
  doc: 
  ```
  Parses reverse polish notation string and generating a code in C for it. If the stack is too 
  small for the operation execution, nothing generates for this operation.
  ```
  
  fun var-name(i): "t" + num-to-string(i) end
  
  fun gen-push(var-id, n):
    format(
      "  double {0} = {1};\n", 
      [list: var-name(var-id), num-to-string-digits(n, 10)]
    )
  end
  
  fun gen-binary(var-id, op):
    if var-id < 2:  "" else: 
      format(
        "  double {0} = {1} {2} {3};\n", 
        [list: var-name(var-id), var-name(var-id - 2), op, var-name(var-id - 1)]
      )
    end
  end
  
  fun gen-unary(var-id, op):
    if var-id < 1: "" else: 
      format(
        "  double {0} = {1}({2});\n", 
        [list: var-name(var-id), op, var-name(var-id - 1)]
      )
    end
  end
  
  var var-id = 0
  var txt = ""
  
  for each(op from parse-reverse-polish-notation(s)) block:
    txt := txt + cases(CalcOp) op:
      | push-op(n) => gen-push(var-id, n)
      | bin-op(shadow op) => gen-binary(var-id, op)
      | un-op(shadow op) => gen-unary(var-id, op)
    end
    var-id := var-id + 1
  end
  
  format(
    "#include <stdio.h>\n#include <math.h>\nint main(int argc, char** argv) {\n{0}  return 0;\n}\n",
    [list: txt + 
      if var-id == 0: "" else: 
        format(
          "  printf(\"%d\\n\", {0});\n", 
          [list: var-name(var-id - 1)]
        ) 
      end
    ]
  )
end