Смешанные операторы с Fparsec

Question

Как мы можем проанализировать операторы mixfix с FParsec?

Я попытался создать тип класса, который выглядит как OperatorPrecedenceParser:

let identifier = many1Satisfy (fun c -> isLetter c || isDigit c || c = ''')

let symbol =
    [ '!'; '@'; '&'; ','; '%'; '^'; '.';
      '§'; '*'; '°'; '$'; '~'; ':'; '-';
      '+'; '='; '?'; '/'; '>'; '<'; '|'; ]

module Operator =

        type public Fixity =
            | Left | Right | Neutral

        let defaultPrecedence = 3

        type public Mixfix =
            { nameParts: Identifier list; // the components of the mixfix function
              fullname: Identifier;       // the full operator name
              mutable fixity: Fixity;     // the fixity of the function
              mutable prec: int;          // operator precedence
              arity: int }                // number of arguments (starts to 1)
        with member this.update fixity prec =
                        this.fixity <- fixity
                        this.prec <- prec

        let private set'nameParts ids =
            List.filter (fun id -> id <> "_") ids

        let private set'fullname (id: Identifier list) =
            System.String.Join("", id)

        /// by default value
        let private set'fixity (id: Identifier list) =
            if id.First() = "_"
            then Left
            elif id.Last() <> "_"
            then Neutral
            else Right

        let private set'arity (id: Identifier list) =
            int (List.countWith (fun s -> s = "_") id)

        let identifier = attempt identifier <|> operator

        let makeApp expr1 expr2 = App(expr1, expr2)

        let makeApps expr1 (exprs: SL list) =
            List.fold
                (fun acc e -> makeApp acc e)
                (makeApp expr1 (exprs.First()))
                    (exprs
                        |> List.rev
                        |> List.dropLast
                        |> List.rev)

        type MixFoxOp (ptv: Parser<_, _> option) =
            member private this.operators : Mixfix list ref = ref []

            member private this.termParser : Parser<_, _> list ref =
                if ptv.IsNone
                then ref []
                else ref [ptv.Value]

            member private this.termValue = choice !this.termParser

            member private this.addMixFix (mixfix: Mixfix) =
                this.operators.Value <- this.operators.Value @ [mixfix]

            member public this.contains id =
                List.exists (fun s -> s.fullname = id) this.operators.Value

            member private this.addMixFixOperator id fixity prec =
                if this.contains (set'fullname id) = false
                then this.addMixFix
                     { nameParts = set'nameParts id;
                       fullname = set'fullname id;
                       fixity = fixity;
                       prec = prec;
                       arity = set'arity id }
                else failwithf "Already defined function"

            member public this.addOperator (id: Identifier list) (fixity: Fixity option) (prec: int option) =
                this.addMixFixOperator id
                    (if fixity.IsNone then set'fixity id else fixity.Value)
                    (if prec.IsNone then defaultPrecedence else prec.Value)

            member public this.setTermValue ptvalue =
                this.termParser := !this.termParser @ [ptvalue]
                ()

            member public this.expressionParser =
                parse {
                    let mutable nameParts  : Identifier list = []
                    let mutable valueParts : Value list = []

                    let addNamePartRet name =
                        nameParts <- nameParts @ [name]
                        preturn name

                    let addValuePartRet value =
                        valueParts <- valueParts @ [value]
                        nameParts <- nameParts @ ["_"]
                        preturn value

                    do! (attempt ((attempt identifier <|> symbol) >>= fun id -> addNamePartRet id) <|> (ws >>% "")) >>?
                        sepEndBy
                            (bws (this.termValue (* <|> this.expressionParser*)) >>= fun x -> addValuePartRet x)
                            (bws identifier
                                >>= fun id -> addNamePartRet id) >>% ()

                    let fullname = set'fullname nameParts
                    if this.contains fullname
                    then return makeApps (Var fullname) valueParts
                    elif valueParts.Length = 1 && nameParts.First() = "_"
                    then return valueParts.First()
                    else fail (sprintf "Unknown mixfix function: `%s`" fullname)
                }

При таком использовании:

let opp = new Operator.MixFixOp(Some value)
opp.addOperator ["|"; "_"; "|"] None None   // abscisse
opp.addOperator ["_"; "!"] None None        // factorial
opp.addOperator ["_"; ","; "_"] None None   // tuple
opp.addOperator ["if"; "_"; "then"; "_"; "else"; "_"]
// ...    

let test = run (opp.expressionParser .>>? eof) "|32|"

И, например:

type Expr =
    | Var of string
    | App of Expr * Expr
    | Int of int

let pint = pint32 |>> Int
let pvar = identifier |>> Var
let value' = attempt pint <|> pvar
let app = chainl1 value' (spaces1 >>% fun x y -> App(x, y))
let value = app
let opp = new Operator.MixFixOp(Some value)
...

Но, уже, он не очень удовлетворителен как метод, потому что он требует заранее знать, какой синтаксический анализатор использовать в качестве термина операции, поэтому мынельзя использовать операторы в этих синтаксических анализаторах (метод setTermValue был добавлен в тип, но не работает, действительно, при каждом использовании termParser остается пустым, не обновляется), тогда мы не знаем, какиспользуйте expressionParser, не получая бесконечный цикл, он не управляет фиксированностью или приоритетом, и, наконец, возникают конфликты с синтаксическими анализаторами для использования в качестве термина, если мы ожидаем, например, идентификатор, как в примерах.

В долгосрочной перспективе, благодаря этому синтаксическому анализатору типов, я хотел бы иметь возможность разбирать выражения, такие как:

3 + 1 + 4
|32!|
if x > y then 0 else 1

Как я могу улучшить этот модуль и сделать его работоспособным?

Буду очень признателен, еслиВы могли бы помочь мне:)