rpn.mll

{
  open Lexing
  open Printf

  let newline lexbuf =
    let pos = lexbuf.lex_curr_p in
    lexbuf.lex_curr_p <-
      { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum }

  let error lexbuf msg =
    let pos = lexeme_start_p lexbuf in
    let l = pos.pos_lnum in
    let c = pos.pos_cnum - pos.pos_bol + 1 in
    failwith @@ sprintf "%s at line %d, character %d" msg l c

  let stack = Stack.create ()

  let get_operands lexbuf stack =
    if Stack.length stack < 2 then
      error lexbuf "Operator expects two operands";
    let op2 = Stack.pop stack in
    let op1 = Stack.pop stack in
    op1, op2
}

let digit = ['0'-'9']
let float_literal = ['+' '-']? digit+ ('.' digit* )? (['e' 'E'] ['+' '-']? digit+)?
let space = [' ' '\t']

rule rpn = parse
  | '\n'    {
              newline lexbuf;
              rpn lexbuf
            }
  | space+  { rpn lexbuf }
  | float_literal as f
            {
              Stack.push (float_of_string f) stack;
              rpn lexbuf
            }
  | '+'     {
              let op1, op2 = get_operands lexbuf stack in
              Stack.push (op1 +. op2) stack;
              rpn lexbuf
            }
  | '-'     {
              let op1, op2 = get_operands lexbuf stack in
              Stack.push (op1 -. op2) stack;
              rpn lexbuf
            }
  | '*'     {
              let op1, op2 = get_operands lexbuf stack in
              Stack.push (op1 *. op2) stack;
              rpn lexbuf
            }
  | "**"    {
              let op1, op2 = get_operands lexbuf stack in
              Stack.push (op1 ** op2) stack;
              rpn lexbuf
            }
  | '/'     {
              let op1, op2 = get_operands lexbuf stack in
              Stack.push (op1 /. op2) stack;
              rpn lexbuf
            }
  | eof     {
              if Stack.length stack <> 1 then
                error lexbuf "Not a valid expression"
              else
                printf "The result is: %.15f\n" (Stack.pop stack)
            }
  | _ as c  {
             sprintf "Character %c is not expected" c |> error lexbuf
            }

{
  let () = rpn (from_channel stdin)
}