namespace ASTvsInterface

type Operation = Plus | Minus

type Exp =
    | Integer of int
    | Binop of Exp * Operation * Exp

open FParsec

module Parser =
    let pop: Parser<Operation, unit> = ["+", Plus; "-", Minus] |> List.map (fun(s, op) -> pstring s >>% op) |> choice

    let pexp, pexpImp = createParserForwardedToRef<Exp, unit>();

    let pterm = pint32 |>> Integer

    do pexpImp := pterm .>>. many (pop .>>. pterm) |>> (fun (t, opts) -> List.fold(fun acc (op, e) -> Binop(acc, op, e)) t opts)

    let runExc p s =
        match run p s with
        | Failure (errString,_,_) -> failwithf "could not parse %s" errString
        | Success(v, _, _) -> v

    let parse s = runExc (pexp .>> eof) s

module Eval =
    let evalOp =
        function
        | Plus -> (+)
        | Minus -> (-)
    let rec eval =
        function
        | Integer i -> i
        | Binop (el, op, er) -> evalOp op (eval el) (eval er)
    let evalString s =
        eval <| Parser.parse s

type IVisit =
    abstract member Integer : int -> unit
    abstract member Operation : Operation -> unit

module ImpParser =
    let parse (v: IVisit) s =
        let pexp, pexpImp = createParserForwardedToRef<unit, unit>();
        let pterm = pint32 |>> v.Integer
        do pexpImp :=
            pterm >>. (skipMany(Parser.pop .>> pexp |>> v.Operation))
        Parser.runExc (pexp .>> eof) s

type Evaluator() =
    let stack = ref []

    let takeTwo() =
        match !stack with
        | s1 :: s2 :: srest ->
            let t = s1, s2, srest
            stack := srest
            t
        | _ -> failwith "error stack did not contain two elements"

    member this.PeekTop = List.exactlyOne !stack

    interface IVisit with
        member this.Integer i = stack := i :: !stack
        member this.Operation op =
                let s1, s2, srest = takeTwo()
                stack := Eval.evalOp op s2 s1 :: srest

module ImpEval =
    let eval s =
        let evaluator = Evaluator()
        ImpParser.parse evaluator s
        evaluator.PeekTop