Mixfix operators with Fparsec - parsing

Question

How could we parse mixfix operators with FParsec?
I tried to create a class type that looks like 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)
}
With a use such as this:
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|"
And for example:
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)
...
But, already, it is not very satisfying as a method, because it requires knowing in advance which parser to use as an operation term, so we can't use operators in these parsers (a setTermValue method has been added in the type, but does not work, indeed, with each use, termParser remains empty, does not update), then we do not know how to use expressionParser without getting an infinite loop, it doesn't manage fixity or precedence, and finally, there are conflicts with the parsers to use as a term, if we expect for example an identifier, as in the examples.
In the long run, thanks to this type-class-parser, I would like to be able to parse expressions such as:
3 + 1 + 4
|32!|
if x > y then 0 else 1
How could I improve this module, and make it operational?
I would be very grateful if you could help me :)