Infix Mul-Add Evaluation

infix-eval.fs

module Parsing = 
  open System.Collections.Generic

  let (|Mul|_|) ch = if ch = '*' then Some(fun a b -> a * b) else None
  let (|Add|_|) ch = if ch = '+' then Some(fun a b -> a + b) else None
  let (|Space|_|) (ch:Char) = if Char.IsWhiteSpace ch then Some(ch) else None
  let (|Digit|_|) (ch:Char) = if Char.IsDigit ch then (new String ([|ch|])) |> Int32.Parse |> Some else None

  type Token = 
  | Number of int
  | WhiteSpace
  | MulOp of (int -> int -> int)
  | AddOp of (int -> int -> int)
  | Error of int

  let rec snarfWhitespace (cch : char[]) (i, t) = 
    if (i < cch.Length) then
      match (cch.[i], t) with
      | (Space _, WhiteSpace) -> snarfWhitespace cch (i+1, WhiteSpace) 
      | _ -> (i, t)
    else (i,t)

  let rec snarfNumber (cch : char[]) (i, t) = 
    if (i < cch.Length) then
      match (cch.[i], t) with
      | (Digit d, Number n) -> snarfNumber cch (i+1, Number (n * 10 + d))
      | _ -> (i, t)
    else (i,t)

  let rec snarfToken (cch : char[]) i =
    if (i < cch.Length) then
      match (cch.[i]) with
      | Space _ -> snarfWhitespace cch (i, WhiteSpace)
      | Digit _ -> snarfNumber cch (i, Number 0)
      | Mul f -> (i+1, MulOp f)
      | Add f -> (i+1, AddOp f)
      | _ -> (i, Error i)
    else (i, Error i)

  let tokenize (str: String) = 
    let cch = str.ToCharArray ()
    
    let mutable result = []
    let mutable run = true
    let mutable i = 0

    while run do
      let (index, token) = snarfToken cch i
      result <- 
        match token with
        | Error _ -> [token]
        | _ -> result  @ [token]
      run <-
        match (index, token) with
        | (_, Error _) -> false
        | (_, _) -> (index < cch.Length)
      i <- index
    result

  let evaluate (str: String) = 
    let shunt (queue: Queue<Token>, stack:Stack<Token>) token = 
      match token with
      | WhiteSpace -> ()
      | Number _ -> token |> queue.Enqueue; 
      | AddOp _ | MulOp _ ->                 
        let last = if (stack.Count > 0) then Some(stack.Peek ()) else None
        match token, last with
        | AddOp _, Some (AddOp _) -> token |> queue.Enqueue |> ignore
        | AddOp _, Some (MulOp _) -> stack.Pop () |> queue.Enqueue |> ignore; token |> stack.Push |> ignore
        | AddOp _, None           -> token |> stack.Push    |> ignore
        | MulOp _, Some (MulOp _) -> token |> queue.Enqueue |> ignore
        | MulOp _, Some (AddOp _) -> token |> stack.Push    |> ignore
        | MulOp _, None           -> token |> stack.Push    |> ignore
        | _, _ -> ()
      | Error x -> queue.Clear (); token |> queue.Enqueue; stack.Clear ()

    let evaluateOutputQueue (queue: Queue<Token>) = 
      match (queue.Peek ()) with
      | Error _ -> None
      | _ -> 
      let evaluationStack = new Stack<int> ()

      while (queue.Count > 0) do 
        match queue.Dequeue () with
        | Number d -> d |> evaluationStack.Push
        | MulOp f | AddOp f -> 
          match (evaluationStack.Pop (), evaluationStack.Pop ()) with 
          | x, y -> (f x y) |> evaluationStack.Push |> ignore
        | _ -> evaluationStack.Clear();

      if (evaluationStack.Count = 0) then None else evaluationStack.Pop () |> Some            

    let outputQueue = new Queue<Token> ()
    let operatorStack = new Stack<Token> ()
    
    str |> tokenize |> List.iter (shunt (outputQueue, operatorStack)) 
    while (operatorStack.Count > 0) do outputQueue.Enqueue(operatorStack.Pop ())
    evaluateOutputQueue outputQueue

tests.fs

"1+2+3" |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" (Some (1+2+3))
"3*6"   |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" (Some (3*6))
"3*6+2" |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" (Some (3*6+2))
"2+3*6" |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" (Some (2+3*6))
"3*6*2" |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" (Some (3*6*2))
"1+a+3" |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" None