hpryu.ml

module type CALC = sig
  type stack

  val display_stack: (stack -> string)
  val evaluate: (string -> string)
end

module Calc : CALC = struct
  open Core.Std
  open Num

  exception Invalid_token
  exception Stack_underflow

  type token = string
  type stack = num list
  type oper = stack -> stack
  type binary = (num -> num -> num)
  type unary = (num -> num)

  type atom = | Value of num
              | Oper of oper

  let string_of_num n = (float_of_num n) |> sprintf "%.*f" 10

  let oper_of_binary (f: binary): oper =
    fun stk -> match stk with
      | x :: y :: xs -> (f y x) :: xs
      | _ -> raise Stack_underflow

  let oper_of_unary (f: unary): oper =
    fun stk -> match stk with
      | x :: xs -> (f x) :: xs
      | _ -> raise Stack_underflow

  let num_of_token (tkn: token): num =
    match (String.split_on_chars ~on:['.'] tkn) with
      | [whole] -> num_of_string whole
      | [whole; part] ->
        let whole_num = num_of_string whole in
        let numer = num_of_string part in
        let denom = Int.pow 10 (String.length part) |> num_of_int in
        whole_num +/ (numer // denom)
      | _ -> raise Invalid_token

  let token_to_atom: (token -> atom) = function
    | "+"   -> Oper (oper_of_binary add_num)
    | "-"   -> Oper (oper_of_binary sub_num)
    | "*"   -> Oper (oper_of_binary mult_num)
    | "/"   -> Oper (oper_of_binary div_num)
    | "abs" -> Oper (oper_of_unary abs_num)
    | "mod" -> Oper (oper_of_binary mod_num)
    | tkn   -> Value (num_of_token tkn)

  let eval (stk: stack) (atm: atom): stack =
    match atm with
      | Oper (fn) -> (fn stk)
      | Value (v) -> (v :: stk)

  let display_stack (stk: stack): string =
    let rec loop reg stk str =
      match (reg, stk) with
        | ([], _) | (_, []) -> str
        | (r::rs, s::ss) ->
          let v = string_of_num s in
          loop rs ss (str ^ r ^ v) in
    loop ["X: ";"; Y: ";"; Z: ";"; T: "] stk ""

  let calculate (atoms: atom list): stack =
      List.fold ~init:[] ~f:eval atoms
    
  let evaluate (line: string): string =
    try
      line
      |> String.split_on_chars ~on:[' ']
      |> List.map ~f:token_to_atom
      |> calculate
      |> display_stack
    with exc -> Exn.to_string exc
end


let _ =
  try
    while true do
      let line = read_line () in
      if String.length line > 0
      then Calc.evaluate line |> Core.Std.printf "%s\n"
      else raise End_of_file
    done
  with
      End_of_file -> ()
;;