2-op infix expression evaluator

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 tokenize (str: String) = 
        let rec snarfToken (cch : char[]) i =
            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)

            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 rec tokenizeInternal i (cch: char[])  = 
            if (i >= cch.Length) then []
            else
                let (index, token) = snarfToken cch i
                match token with
                | Error _ -> [token]
                | _ -> token :: tokenizeInternal index cch

        str.ToCharArray () |> tokenizeInternal 0 |> List.rev

    // Dijkstra's Shunting Yard algorithm for infix evaluation
    // http://en.wikipedia.org/wiki/Shunting-yard_algorithm
    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 -> 
                        let arg1 = if evaluationStack.Count > 0 then evaluationStack.Pop () |> Some else None
                        let arg2 = if evaluationStack.Count > 0 then evaluationStack.Pop () |> Some else None
                        match (arg1, arg2) with 
                        | Some x, Some y -> (f x y) |> evaluationStack.Push |> ignore
                        | _ -> evaluationStack.Clear () |> ignore
                    | _ -> evaluationStack.Clear () |> ignore

                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
"1+1+"  |> Parsing.evaluate |> printfn "Expected: %A; Actual: %A" None