StupidParser2.fs

module StupidParser =
  open System

  // General Parser functions & types
  type ParserState        = string*int
  type ParserResult<'T>   = ('T*ParserState) option
  type Parser<'T>         = ParserState -> ParserResult<'T>

  let success v ps  : ParserResult<_> = (v, ps) |> Some
  let failure       : ParserResult<_> = None

  let ``\0`` : Parser<Unit> =
    fun (s,i) ->
      if i < s.Length then failure
      else success () (s, s.Length)

  let foldAtLeast n f z : Parser<_> =
    fun (s,i) ->
      let rec loop v p =
        if p < s.Length then
          match f v s.[p] with
          | Some v  -> loop v (p + 1)
          | _       -> v, p
        else
          v, p
      let v, p = loop z i
      if i + n <= p then success v (s, p)
      else failure

  let pick picks : Parser<_> =
    fun (s,i) ->
      if i < s.Length then
        let c = s.[i]
        match picks |> Array.tryFind (fst >> (=) c) with
        | Some (_, v) -> success v (s, (i + 1))
        | _ -> failure
      else failure

  let sepBy (|Term|_|) (|Separator|_|) : Parser<int> =
    let rec loop = function
      | Term (tv, Separator (sep, Loop (lv, ps))) -> success (sep tv lv) ps
      | Term (tv, ps) -> success tv ps
      | _ -> failure
    and (|Loop|_|) = loop
    loop

  let (.>>) (|Left|_|) (|Right|_|) : Parser<_> = function
    | Left (v, Right (_, ps)) -> success v ps
    | _ -> failure

  let (>>.) (|Left|_|) (|Right|_|) : Parser<_> = function
    | Left (_, Right (v, ps)) -> success v ps
    | _ -> failure

  // Calculator expression parser
  let `` ``     = foldAtLeast 0 (fun _ c -> if Char.IsWhiteSpace c then Some () else None) ()
  let ``(``     = pick [|'(', ()|] .>> `` ``
  let ``)``     = pick [|')', ()|] .>> `` ``
  let ``*/``    = pick [|'*', (*); '/', (/)|] .>> `` ``
  let ``+-``    = pick [|'+', (+); '-', (-)|] .>> `` ``

  let (|Int|_|) = foldAtLeast 1 (fun v c -> if Char.IsDigit c then Some (v + int c - int '0') else None) 0 .>> `` ``
  let rec term  = function
    | Sub (v, ps) -> success v ps
    | Int (v, ps) -> success v ps
    | _           -> failure
  and ``e*/e``  = sepBy term ``*/``
  and ``e+-e``  = sepBy ``e*/e`` ``+-``
  and (|Sub|_|) = ``(`` >>. ``e+-e`` .>> ``)``
  let full      = `` `` >>. ``e+-e`` .>> ``\0``

  let parse s   =
    match full (s, 0) with
    | Some (v, _) -> Some v
    | _           -> None

[<EntryPoint>]
let main argv =
  let examples = [| " 1 "; "1 - 3"; "1*3"; "1 + 2*3 - 2"; "1 + 2*(3 - 2)" |]
  for example in examples do
    match StupidParser.parse example with
    | Some v -> printfn "%s -> %d" example v
    | _ -> printfn "%s -> FAILED" example
  0