I am coding a parser (for learning pourpuses).
I want it to parse constructions like
let myVar be 40 plus 2
and
let myVar be (40 plus 2)
With no problems... but my parser does not "understand" the former. It sees the 40
and thinks "well, it's a Literal Numeric 40
".
When I put parentheses, my parser works great.
I am having a hard time to understand why.
Parser:
type value =
| Boolean of bool
| Numeric of float
| String of string
type arithmetic = Sum | Sub | Mul | Div | Pow
type logic = And | Or | Equal | NotEqual | Greater | Smaller
type identifier =
| Identifier of string
type expression =
| Literal of value
| Arithmetic of expression * arithmetic * expression
| Negative of expression
| Negation of expression
| Logic of expression * logic * expression
| Variable of identifier
type statement =
| Assignment of identifier * expression
| Print of expression
| Read of identifier
let private ws = spaces
let private str s = pstring s .>> ws
let private pnumeric =
pfloat
.>> ws
|>> fun n -> Literal (Numeric n)
let private pboolean =
choice [
(stringReturn "true" (Literal (Boolean true)))
(stringReturn "false" (Literal (Boolean false)))
]
.>> ws
let private pstringliteral =
choice [
between (pstring "\"") (pstring "\"") (manyChars (satisfy (fun c -> c <> '"')))
between (pstring "'") (pstring "'") (manyChars (satisfy (fun c -> c <> ''')))
]
|>> fun s -> Literal (String s)
let private pidentifier =
many1Satisfy2L isLetter (fun c -> isLetter c || isDigit c) "identifier"
|>> fun s -> Identifier s
let private betweenParentheses p =
between (str "(") (str ")") p
let private pvalue =
choice [
pnumeric
pboolean
]
let private prefixOperator (p: OperatorPrecedenceParser<_,_,_>) op prec map =
p.AddOperator(PrefixOperator (op, ws, prec, true, map))
let private infixOperator (p: OperatorPrecedenceParser<_,_,_>) op prec map =
p.AddOperator(InfixOperator (op, ws, prec, Associativity.Left, map))
let private oppNegation = new OperatorPrecedenceParser<_,_,_>()
let private oppLogic = new OperatorPrecedenceParser<_,_,_>()
let private oppArithmetic = new OperatorPrecedenceParser<_,_,_>()
let private oppNegative = new OperatorPrecedenceParser<_,_,_>()
prefixOperator oppNegation "not" 1 (fun x -> Negation x)
infixOperator oppLogic "is" 1 (fun x y -> Logic (x, Equal, y))
infixOperator oppLogic "isnt" 1 (fun x y -> Logic (x, NotEqual, y))
infixOperator oppLogic "and" 2 (fun x y -> Logic (x, And, y))
infixOperator oppLogic "or" 3 (fun x y -> Logic (x, Or, y))
prefixOperator oppNegative "-" 1 (fun x -> Negative x)
infixOperator oppArithmetic ">" 1 (fun x y -> Logic (x, Greater, y))
infixOperator oppArithmetic "<" 1 (fun x y -> Logic (x, Smaller, y))
infixOperator oppArithmetic "is" 2 (fun x y -> Logic (x, Equal, y))
infixOperator oppArithmetic "isnt" 2 (fun x y -> Logic (x, NotEqual, y))
infixOperator oppArithmetic "plus" 3 (fun x y -> Arithmetic (x, Sum, y))
infixOperator oppArithmetic "minus" 3 (fun x y -> Arithmetic (x, Sub, y))
infixOperator oppArithmetic "times" 4 (fun x y -> Arithmetic (x, Mul, y))
infixOperator oppArithmetic "divided by" 4 (fun x y -> Arithmetic (x, Div, y))
infixOperator oppArithmetic "power" 5 (fun x y -> Arithmetic (x, Pow, y))
let private negationExprParser = oppNegation.ExpressionParser
let private logicExprParser = oppLogic.ExpressionParser
let private arithmeticExprParser = oppArithmetic.ExpressionParser
let private negativeExprParser = oppNegative.ExpressionParser
oppNegation.TermParser <- choice [
betweenParentheses negationExprParser
pboolean
]
oppLogic.TermParser <- choice [
betweenParentheses logicExprParser
pboolean
]
oppNegative.TermParser <- choice [
betweenParentheses negativeExprParser
pnumeric
]
oppArithmetic.TermParser <- choice [
betweenParentheses arithmeticExprParser
pnumeric
]
let private pexpression =
choice [
attempt <| pstringliteral
attempt <| negationExprParser
attempt <| logicExprParser
attempt <| negativeExprParser
attempt <| arithmeticExprParser
attempt <| (pidentifier |>> fun id -> Variable id)
]
let private passignment =
pipe2 (str "let" .>> ws >>. pidentifier) (ws >>. str "be" >>. ws >>. pexpression) (fun id exp -> Assignment (id, exp))
let private pprint =
str "print"
>>. pexpression
|>> fun exp -> Print exp
let private pread =
str "read"
>>. pidentifier
|>> fun id -> Read id
let private pstatement =
choice [
passignment
pprint
pread
]
let private pline =
skipMany (satisfy (fun c -> c = '\n' || c = ' '))
>>. pstatement
.>> ws
let private pcode =
many pline
let generateAST code =
match run pcode code with
| Success (ast, _, _) -> sprintf "%A" ast
| Failure (msg, _, _) -> msg
Usage:
[<EntryPoint>]
let main argv =
printfn "%s\n" (generateAST "let b be 5 plus 7")
// [Assignment (Identifier "b",Literal (Numeric 5.0))]
printfn "%s\n" (generateAST "let b be (5 plus 7)")
// [Assignment
// (Identifier "b",Arithmetic (Literal (Numeric 5.0),Sum,Literal (Numeric 7.0)))]
0
Take a look at FParsec - Tracing a parser
If you add the recommended FParsec tracing function to the top of your code
let (<!>) (p: Parser<_,_>) label : Parser<_,_> =
fun stream ->
printfn "%A: Entering %s" stream.Position label
let reply = p stream
printfn "%A: Leaving %s (%A)" stream.Position label reply.Status
reply
then modify the parsers to use the trace function
let private pnumeric =
(pfloat
.>> ws
|>> fun n -> Literal (Numeric n)) <!> "pnumeric"
let private pboolean =
(choice [
(stringReturn "true" (Literal (Boolean true)))
(stringReturn "false" (Literal (Boolean false)))
]
.>> ws) <!> "pboolean"
let private pstringliteral =
(choice [
between (pstring "\"") (pstring "\"") (manyChars (satisfy (fun c -> c <> '"')))
between (pstring "'") (pstring "'") (manyChars (satisfy (fun c -> c <> ''')))
]
|>> fun s -> Literal (String s)) <!> "pstringliteral"
let private pidentifier =
(many1Satisfy2L isLetter (fun c -> isLetter c || isDigit c) "identifier"
|>> fun s -> Identifier s) <!> "pidentifier"
let private betweenParentheses p =
(between (str "(") (str ")") p) <!> "betweenParentheses"
let private pvalue =
(choice [
pnumeric
pboolean
]) <!> "pvalue"
let private negationExprParser = oppNegation.ExpressionParser <!> "negationExprParser"
let private logicExprParser = oppLogic.ExpressionParser <!> "logicExprParser"
let private arithmeticExprParser = oppArithmetic.ExpressionParser <!> "arithmeticExprParser"
let private negativeExprParser = oppNegative.ExpressionParser <!> "negativeExprParser "
let private pexpression =
choice [
attempt <| pstringliteral
attempt <| negationExprParser
attempt <| logicExprParser
attempt <| negativeExprParser
attempt <| arithmeticExprParser
attempt <| (pidentifier |>> fun id -> Variable id)
] <!> "pexpression"
let private passignment =
pipe2 (str "let" .>> ws >>. pidentifier) (ws >>. str "be" >>. ws >>. pexpression) (fun id exp -> Assignment (id, exp)) <!> "passignment"
let private pprint =
(str "print"
>>. pexpression
|>> fun exp -> Print exp) <!> "pprint"
let private pread =
(str "read"
>>. pidentifier
|>> fun id -> Read id) <!> "pread"
let private pstatement =
(choice [
passignment
pprint
pread
]) <!> "pstatement"
let private pline =
(skipMany (satisfy (fun c -> c = '\n' || c = ' '))
>>. pstatement
.>> ws) <!> "pline"
let private pcode =
many pline <!> "pcode"
and run the code you will get
(Ln: 1, Col: 1): Entering pcode
(Ln: 1, Col: 1): Entering pline
(Ln: 1, Col: 1): Entering pstatement
(Ln: 1, Col: 1): Entering passignment
(Ln: 1, Col: 5): Entering pidentifier
(Ln: 1, Col: 6): Leaving pidentifier (Ok)
(Ln: 1, Col: 10): Entering pexpression
(Ln: 1, Col: 10): Entering pstringliteral
(Ln: 1, Col: 10): Leaving pstringliteral (Error)
(Ln: 1, Col: 10): Entering negationExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 10): Leaving betweenParentheses (Error)
(Ln: 1, Col: 10): Entering pboolean
(Ln: 1, Col: 10): Leaving pboolean (Error)
(Ln: 1, Col: 10): Leaving negationExprParser (Error)
(Ln: 1, Col: 10): Entering logicExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 10): Leaving betweenParentheses (Error)
(Ln: 1, Col: 10): Entering pboolean
(Ln: 1, Col: 10): Leaving pboolean (Error)
(Ln: 1, Col: 10): Leaving logicExprParser (Error)
(Ln: 1, Col: 10): Entering negativeExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 10): Leaving betweenParentheses (Error)
(Ln: 1, Col: 10): Entering pnumeric
(Ln: 1, Col: 12): Leaving pnumeric (Ok)
(Ln: 1, Col: 12): Leaving negativeExprParser (Ok)
(Ln: 1, Col: 12): Leaving pexpression (Ok)
(Ln: 1, Col: 12): Leaving passignment (Ok)
(Ln: 1, Col: 12): Leaving pstatement (Ok)
(Ln: 1, Col: 12): Leaving pline (Ok)
(Ln: 1, Col: 12): Entering pline
(Ln: 1, Col: 12): Entering pstatement
(Ln: 1, Col: 12): Entering passignment
(Ln: 1, Col: 12): Leaving passignment (Error)
(Ln: 1, Col: 12): Entering pprint
(Ln: 1, Col: 12): Leaving pprint (Error)
(Ln: 1, Col: 12): Entering pread
(Ln: 1, Col: 12): Leaving pread (Error)
(Ln: 1, Col: 12): Leaving pstatement (Error)
(Ln: 1, Col: 12): Leaving pline (Error)
(Ln: 1, Col: 12): Leaving pcode (Ok)
[Assignment (Identifier "b",Literal (Numeric 5.0))]
(Ln: 1, Col: 1): Entering pcode
(Ln: 1, Col: 1): Entering pline
(Ln: 1, Col: 1): Entering pstatement
(Ln: 1, Col: 1): Entering passignment
(Ln: 1, Col: 5): Entering pidentifier
(Ln: 1, Col: 6): Leaving pidentifier (Ok)
(Ln: 1, Col: 10): Entering pexpression
(Ln: 1, Col: 10): Entering pstringliteral
(Ln: 1, Col: 10): Leaving pstringliteral (Error)
(Ln: 1, Col: 10): Entering negationExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 11): Entering negationExprParser
(Ln: 1, Col: 11): Entering betweenParentheses
(Ln: 1, Col: 11): Leaving betweenParentheses (Error)
(Ln: 1, Col: 11): Entering pboolean
(Ln: 1, Col: 11): Leaving pboolean (Error)
(Ln: 1, Col: 11): Leaving negationExprParser (Error)
(Ln: 1, Col: 11): Leaving betweenParentheses (Error)
(Ln: 1, Col: 11): Leaving negationExprParser (Error)
(Ln: 1, Col: 10): Entering logicExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 11): Entering logicExprParser
(Ln: 1, Col: 11): Entering betweenParentheses
(Ln: 1, Col: 11): Leaving betweenParentheses (Error)
(Ln: 1, Col: 11): Entering pboolean
(Ln: 1, Col: 11): Leaving pboolean (Error)
(Ln: 1, Col: 11): Leaving logicExprParser (Error)
(Ln: 1, Col: 11): Leaving betweenParentheses (Error)
(Ln: 1, Col: 11): Leaving logicExprParser (Error)
(Ln: 1, Col: 10): Entering negativeExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 11): Entering negativeExprParser
(Ln: 1, Col: 11): Entering betweenParentheses
(Ln: 1, Col: 11): Leaving betweenParentheses (Error)
(Ln: 1, Col: 11): Entering pnumeric
(Ln: 1, Col: 13): Leaving pnumeric (Ok)
(Ln: 1, Col: 13): Leaving negativeExprParser (Ok)
(Ln: 1, Col: 13): Leaving betweenParentheses (Error)
(Ln: 1, Col: 13): Leaving negativeExprParser (Error)
(Ln: 1, Col: 10): Entering arithmeticExprParser
(Ln: 1, Col: 10): Entering betweenParentheses
(Ln: 1, Col: 11): Entering arithmeticExprParser
(Ln: 1, Col: 11): Entering betweenParentheses
(Ln: 1, Col: 11): Leaving betweenParentheses (Error)
(Ln: 1, Col: 11): Entering pnumeric
(Ln: 1, Col: 13): Leaving pnumeric (Ok)
(Ln: 1, Col: 18): Entering betweenParentheses
(Ln: 1, Col: 18): Leaving betweenParentheses (Error)
(Ln: 1, Col: 18): Entering pnumeric
(Ln: 1, Col: 19): Leaving pnumeric (Ok)
(Ln: 1, Col: 19): Leaving arithmeticExprParser (Ok)
(Ln: 1, Col: 20): Leaving betweenParentheses (Ok)
(Ln: 1, Col: 20): Leaving arithmeticExprParser (Ok)
(Ln: 1, Col: 20): Leaving pexpression (Ok)
(Ln: 1, Col: 20): Leaving passignment (Ok)
(Ln: 1, Col: 20): Leaving pstatement (Ok)
(Ln: 1, Col: 20): Leaving pline (Ok)
(Ln: 1, Col: 20): Entering pline
(Ln: 1, Col: 20): Entering pstatement
(Ln: 1, Col: 20): Entering passignment
(Ln: 1, Col: 20): Leaving passignment (Error)
(Ln: 1, Col: 20): Entering pprint
(Ln: 1, Col: 20): Leaving pprint (Error)
(Ln: 1, Col: 20): Entering pread
(Ln: 1, Col: 20): Leaving pread (Error)
(Ln: 1, Col: 20): Leaving pstatement (Error)
(Ln: 1, Col: 20): Leaving pline (Error)
(Ln: 1, Col: 20): Leaving pcode (Ok)
[Assignment
(Identifier "b",Arithmetic (Literal (Numeric 5.0),Sum,Literal (Numeric 7.0)))]
This should help you figure out your problem, but more importantly how to solve future problems with FParsec.