带Fparsec的Mixfix运算符

Question

我们如何用FParsec解析mixfix运算符？

我试图创建一个类似于import json with open ('tweets.json', 'r') as f: for l in f.readlines(): if not l.strip (): # skip empty lines continue json_data = json.loads (l) print (json_data) 的类类型：

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而不会遇到无限循环，不能管理固定性或优先级，最后，如果我们期望例如示例中的标识符，则与解析器用作术语会发生冲突。

从长远来看，由于有了这个type-class-parser，我希望能够解析如下表达式：

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

我如何改进此模块并使它运行？

如果您能帮助我，我将非常感激：）