I have the following program that runs. It takes a line of text and splits it into two parts, the first is an identifier and the second is the remainder of the line. My parser for the identifier (factID) takes any string of characters as the identifier, which is not (quite) what I want. What I want is a parser that only succeeds when it encounters two consecutive upper case letters. So for example "AA" should succeed while "A", "A1" or "AAA" should not.
What I can't figure out is how construct a parser that looks for a fixed length token. I thought perhaps CharParsers.next2CharsSatisfy might be the function I am looking for, but I can't figure out how to properly use it.
open FParsec
let test p str =
match run p str with
| Success(result, _, _) -> printfn "Success: %A" result
| Failure(errorMsg, _, _) -> printfn "Failure: %s" errorMsg
let ws = spaces
let str_ws s = pstring s .>> ws
type StringConstant = StringConstant of string * string
let factID =
let isIdentifierFirstChar c = isLetter c
let isIdentifierChar c = isLetter c
many1Satisfy2L isIdentifierFirstChar isIdentifierChar "factID"
let factText =
let isG c = isLetter c || isDigit c || c = ' ' || c = '.'
manySatisfy isG
let factParse = pipe3 factID (str_ws " ") factText
(fun id _ str -> StringConstant(id, str))
[<EntryPoint>]
let main argv =
test factParse "AA This is some text." // This should pass
test factParse "A1 This is some text." // This should fail
test factParse "AAA This is some text." // This passes but I want it to fail
0 // return an integer exit code
I think this would do it
let pFactID = manyMinMaxSatisfy 2 2 Char.IsUpper
Related
I want to parse a given char twice, but return a string of that character only once.
For example:
aa -> a
I have some code that works, but also some code that does not work, and I don't understand why.
Why are these snippets different?
// Works
let parseEscapedQuote (c : char) =
let q = string c
pstring (q + q) >>% q
// Does not work
let parseEscapedQuote (c : char) =
let q = string c
pchar c >>. pchar c >>% q
The second one will successfully parse a repeated character the way you want, but it might not fail the way you expect. If only the first pchar c succeeds, it will leave your parser in an invalid state. To fix this, you can use attempt, which restores the prior state if it fails:
attempt (pchar c >>. pchar c) >>% q
Here's a complete example that illustrates the difference:
open FParsec
let parseTwiceBad (c : char) =
pchar c >>. pchar c >>% string c
let parseTwiceGood (c : char) =
attempt (pchar c >>. pchar c) >>% string c
let mkParser parseTwice =
choice [
parseTwice 'x'
anyString 3
]
let run parser str =
let result = runParserOnString parser () "" str
match result with
| Success (value, _, _) -> printfn "Success: %A" value
| Failure (msg, _, _) -> printfn "Failure: %s" msg
let test str =
printfn ""
printfn "Parsing \"%s\" with bad parser:" str
let parser = mkParser parseTwiceBad
run parser str
printfn "Parsing \"%s\" with good parser:" str
let parser = mkParser parseTwiceGood
run parser str
[<EntryPoint>]
let main argv =
test "xx"
test "xAx"
0
Output:
Parsing "xx" with bad parser:
Success: "x"
Parsing "xx" with good parser:
Success: "x"
Parsing "xAx" with bad parser:
Failure: Error in Ln: 1 Col: 2
xAx
^
Expecting: 'x'
Parsing "xAx" with good parser:
Success: "xAx"
NOTE: Not long ago, I had already asked a similar question. This is not a duplication, but the clarifications to be requested did not fall within the scope of the subject itself. I therefore allow myself to open another position dealing with the analysis of an ML-like syntax based on indentation, and considering everything as an instruction / expression.
For example:
"Hello" is an expression,
let foo = 2 + 1 is an instruction using an expression (2 + 1),
print foo is an instruction, ...
In short, a syntax and semantics that is quite modular and dynamic. Like F#, or OCaml.
To do this, I use F#, with the API (available on nuget) FParsec. The FParsec wiki provides an example of a syntax based on indentation, so I have taken it up again. The module in the code below used is IndentationParserWithoutBacktracking.
The example code to be parsed uses an elementary indentation, not mixing "literal" and "instructions/expressions":
loop i 1 10
loop k 1 10
print k
print i
print j
A simple code, and without context (but this is not important at the moment).
My implementation allows codes such as:
let foo = a + b
let foo =
let a = 9
let b = 1
a + b
let foo = 7
let foo =
loop i 1 10
print i
For example. (The loop and print are there just for the tests...)
The problem I have been having for a long week now, and that I can't solve, is the fact that the indentation module asks me every time an instruction is expected in a parser for a new line... Here is a screenshot:
This applies to all the examples mentioned above. I don't really understand the problem, and therefore don't know how to solve it.
Here is the code tested for this question, it meets the minimum and functional code criteria, however, FParsec must be used:
open FParsec
// This module come from 'https://github.com/stephan-tolksdorf/fparsec/wiki/Parsing-indentation-based-syntax-with-FParsec'
// I used the second module: 'IndentationParserWithoutBacktracking'
module IndentationParserWithoutBacktracking =
let tabStopDistance = 8
type LastParsedIndentation() =
[<DefaultValue>]
val mutable Value: int32
[<DefaultValue>]
val mutable EndIndex: int64
type UserState =
{Indentation: int
// We put LastParsedIndentation into the UserState so that we
// can conveniently use a separate instance for each stream.
// The members of the LastParsedIndentation instance will be mutated
// directly and hence won't be affected by any stream backtracking.
LastParsedIndentation: LastParsedIndentation}
with
static member Create() = {Indentation = -1
LastParsedIndentation = LastParsedIndentation(EndIndex = -1L)}
type CharStream = CharStream<UserState>
type Parser<'t> = Parser<'t, UserState>
// If this function is called at the same index in the stream
// where the function previously stopped, then the previously
// returned indentation will be returned again.
// This way we can avoid backtracking at the end of indented blocks.
let skipIndentation (stream: CharStream) =
let lastParsedIndentation = stream.UserState.LastParsedIndentation
if lastParsedIndentation.EndIndex = stream.Index then
lastParsedIndentation.Value
else
let mutable indentation = stream.SkipNewlineThenWhitespace(tabStopDistance, false)
lastParsedIndentation.EndIndex <- stream.Index
lastParsedIndentation.Value <- indentation
indentation
let indentedMany1 (p: Parser<'t>) label : Parser<'t list> =
fun stream ->
let oldIndentation = stream.UserState.Indentation
let indentation = skipIndentation stream
if indentation <= oldIndentation then
Reply(Error, expected (if indentation < 0 then "newline" else "indented " + label))
else
stream.UserState <- {stream.UserState with Indentation = indentation}
let results = ResizeArray()
let mutable stateTag = stream.StateTag
let mutable reply = p stream // parse the first element
let mutable newIndentation = 0
while reply.Status = Ok
&& (results.Add(reply.Result)
newIndentation <- skipIndentation stream
newIndentation = indentation)
do
stateTag <- stream.StateTag
reply <- p stream
if reply.Status = Ok
|| (stream.IsEndOfStream && results.Count > 0 && stream.StateTag = stateTag)
then
if newIndentation < indentation || stream.IsEndOfStream then
stream.UserState <- {stream.UserState with Indentation = oldIndentation}
Reply(List.ofSeq results)
else
Reply(Error, messageError "wrong indentation")
else // p failed
Reply(reply.Status, reply.Error)
open IndentationParserWithoutBacktracking
let isBlank = fun c -> c = ' ' || c = '\t'
let ws = spaces
let ws1 = skipMany1SatisfyL isBlank "whitespace"
let str s = pstring s .>> ws
let keyword str = pstring str >>? nextCharSatisfiesNot (fun c -> isLetter c || isDigit c) <?> str
// AST
type Identifier = Identifier of string
// A value is just a literal or a data name, called here "Variable"
type Value =
| Int of int | Float of float
| Bool of bool | String of string
| Char of char | Variable of Identifier
// All is an instruction, but there are some differences:
type Instr =
// Arithmetic
| Literal of Value | Infix of Instr * InfixOp * Instr
// Statements (instructions needing another instructions)
| Let of Identifier * Instr list
| Loop of Identifier * Instr * Instr * Instr list
// Other - the "print" function, from the link seen above
| Print of Identifier
and InfixOp =
// Arithmetic
| Sum | Sub | Mul | Div
// Logic
| And | Or | Equal | NotEqual | Greater | Smaller | GreaterEqual | SmallerEqual
// Literals
let numberFormat = NumberLiteralOptions.AllowMinusSign ||| NumberLiteralOptions.AllowFraction |||
NumberLiteralOptions.AllowHexadecimal ||| NumberLiteralOptions.AllowOctal |||
NumberLiteralOptions.AllowBinary
let literal_numeric =
numberLiteral numberFormat "number" |>> fun nl ->
if nl.IsInteger then Literal (Int(int nl.String))
else Literal (Float(float nl.String))
let literal_bool =
(choice [
(stringReturn "true" (Literal (Bool true)))
(stringReturn "false" (Literal (Bool false)))
]
.>> ws) <?> "boolean"
let literal_string =
(between (pstring "\"") (pstring "\"") (manyChars (satisfy (fun c -> c <> '"')))
|>> fun s -> Literal (String s)) <?> "string"
let literal_char =
(between (pstring "'") (pstring "'") (satisfy (fun c -> c <> '''))
|>> fun c -> Literal (Char c)) <?> "character"
let identifier =
(many1Satisfy2L isLetter (fun c -> isLetter c || isDigit c) "identifier"
|>> Identifier) <?> "identifier"
let betweenParentheses p =
(between (str "(") (str ")") p) <?> ""
let variable = identifier |>> fun id -> Literal (Variable id)
let literal = (attempt literal_numeric <|>
attempt literal_bool <|>
attempt literal_char <|>
attempt literal_string <|>
attempt variable)
// Instressions and statements
let pInstrs, pInstrimpl = createParserForwardedToRef()
// `ploop` is located here to force `pInstrs` to be of the type `Instr list`, `ploop` requesting an instression list.
let ploop =
pipe4
(keyword "loop" >>. ws1 >>. identifier)
(ws1 >>. literal)
(ws1 >>. literal)
(pInstrs)
(fun id min max stmts -> Loop(id, min, max, stmts))
// `singlepInstr` allows to use only one Instression, used just after.
let singlepInstr =
pInstrs |>> fun ex -> ex.Head
let term =
(ws >>. singlepInstr .>> ws) <|>
(betweenParentheses (ws >>. singlepInstr)) <|>
(ws >>. literal .>> ws) <|>
(betweenParentheses (ws >>. literal))
let infixOperator (p: OperatorPrecedenceParser<_, _, _>) op prec map =
p.AddOperator(InfixOperator(op, ws, prec, Associativity.Left, map))
let ops =
// Arithmetic
[ "+"; "-"; "*"; "/"; "%" ] #
// Logical
[ "&&"; "||"; "=="; "!="; ">"; "<"; ">="; "<=" ]
let opCorrespondance op =
match op with
// Arithmetic operators
| "+" -> Sum | "-" -> Sub
| "*" -> Mul | "/" -> Div
// Logical operators
| "&&" -> And | "||" -> Or
| "==" -> Equal | "!=" -> NotEqual
| ">" -> Greater | "<" -> Smaller
| ">=" -> GreaterEqual | "<=" -> SmallerEqual
| _ -> failwith ("Unknown operator: " + op)
let opParser = new OperatorPrecedenceParser<Instr, unit, UserState>()
for op in ops do
infixOperator opParser op 1 (fun x y -> Infix(x, opCorrespondance op, y))
opParser.TermParser <- term
// Statements
(*
- let:
let <identifier> = <instruction(s) / value>
- print:
print <identifier>
- loop:
loop <identifier> <literal> <literal> <indented statements>
*)
let plet =
pipe2
(keyword "let" >>. ws1 >>. identifier)
(ws >>. str "=" >>. ws >>. pInstrs)
(fun id exp -> Let(id, exp))
let print =
keyword "print" >>. ws1 >>. identifier
|>> Print
let instruction =
print <|> ploop <|> plet <|>
opParser.ExpressionParser <|>
literal
pInstrimpl := indentedMany1 instruction "instruction"
let document = pInstrs .>> spaces .>> eof
let test str =
match runParserOnString document (UserState.Create()) "" str with
| Success(result, _, _) -> printfn "%A" result
| Failure(errorMsg, _, _) -> printfn "%s" errorMsg
System.Console.Clear()
let code = test #"
let foo = a + b
"
I would like to understand first of all why it doesn't work, but also to be able to find a solution to my problem, and that this solution can be extended to the potential syntax additions of the parser.
Awaiting a salutary answer, thank you.
In order to understand why your parser doesn't work, you need to isolate the issues.
If I understand you correctly, you want your let parser to support either a single instruction on the same line or indented instructions on subsequent lines, e.g:
let x = instruction
let b =
instruction
instruction
If you can't get your existing implementation to work, I'd recommend going back to the implementation on the Wiki and trying to just add support for the let statement.
For example, I made the Wiki parser accept simple let statements with the following modifications:
type Statement = Loop of Identifier * int * int * Statement list
| Print of Identifier
| Let of Identifier * Statement list
let ws = skipManySatisfy isBlank
let str s = pstring s .>> ws
let statement, statementRef = createParserForwardedToRef()
let indentedStatements = indentedMany1 statement "statement"
let plet = keyword "let" >>. pipe2 (ws1 >>. identifier)
(ws >>. str "=" >>. ws
>>. (indentedStatements
<|> (statement |>> fun s -> [s])))
(fun id exp -> Let(id, exp))
statementRef := print <|> loop <|> plet
Note that in the modified version statement is now the parser forwarded to a ref cell, not indentedStatements.
Note also that ws is not implemented with spaces, like in your parser. This is important because spaces also consumes newlines, which would prevent the indentedMany1 from seeing the newline and properly calculating the indentation.
The reason your parser produced an "Expecting: newline" error is that indentedMany1 needs a newline at the beginning of the indented sequence in order to be able to calculate the indentation. You would have to modify the implementation of indentedMany1 if you wanted to support e.g. the following indentation pattern:
let x = instruction
instruction
instruction
This question, first off, is not a duplicate of my question.
Actually I have 3 questions.
In the code below, I try to create a parser which parses possibly nested multiline block comments. In contrast to the cited other question, I try to solve the problem in a straightforward way without any recursive functions (see the accepted answer to the other post).
The first problem I ran into was that skipManyTill parser of FParsec also consumes the end parser from the stream. So I created skipManyTillEx (Ex for 'excluding endp' ;) ). The skipManyTillEx seems to work - at least for the one test case I also added to the fsx script.
Yet in the code, shown, now I get the "The combinator 'many' was applied to a parser that succeeds without consuming..." error. My theory is, that the commentContent parser is the line which produces this error.
Here, my questions:
Is there any reason, why the approach I have chosen cannot work? The solution in 1, which, unfortunately does not seem to compile on my system uses a recursive low level parser for (nested) multiline comments.
Can anyone see a problem with the way I implemented skipManyTillEx? The way I implemented it differs to some degree from the way skipManyTill is implemented, mostly in the aspect of how to control the parsing flow. In original skipManyTill, the Reply<_> of p and endp is tracked, along with the stream.StateTag. In my implementation, in contrast I did not see the need to use stream.StateTag, solely relying on the Reply<_> status code. In case of an unsuccessful parse, skipManyTillEx backtracks to the streams initial state and reports an error. Could possibly the backtracking code cause the 'many' error? What would I have to do instead?
(and that is the main question) - Does anyone see, how to fix the parser such, that this "many ... " error message goes away?
Here is the code:
#r #"C:\hgprojects\fparsec\Build\VS11\bin\Debug\FParsecCS.dll"
#r #"C:\hgprojects\fparsec\Build\VS11\bin\Debug\FParsec.dll"
open FParsec
let testParser p input =
match run p input with
| Success(result, _, _) -> printfn "Success: %A" result
| Failure(errorMsg, _, _) -> printfn "Failure %s" errorMsg
input
let Show (s : string) : string =
printfn "%s" s
s
let test p i =
i |> Show |> testParser p |> ignore
////////////////////////////////////////////////////////////////////////////////////////////////
let skipManyTillEx (p : Parser<_,_>) (endp : Parser<_,_>) : Parser<unit,unit> =
fun stream ->
let tryParse (p : Parser<_,_>) (stm : CharStream<unit>) : bool =
let spre = stm.State
let reply = p stream
match reply.Status with
| ReplyStatus.Ok ->
stream.BacktrackTo spre
true
| _ ->
stream.BacktrackTo spre
false
let initialState = stream.State
let mutable preply = preturn () stream
let mutable looping = true
while (not (tryParse endp stream)) && looping do
preply <- p stream
match preply.Status with
| ReplyStatus.Ok -> ()
| _ -> looping <- false
match preply.Status with
| ReplyStatus.Ok -> preply
| _ ->
let myReply = Reply(Error, mergeErrors preply.Error (messageError "skipManyTillEx failed") )
stream.BacktrackTo initialState
myReply
let ublockComment, ublockCommentImpl = createParserForwardedToRef()
let bcopenTag = "/*"
let bccloseTag = "*/"
let pbcopen = pstring bcopenTag
let pbcclose = pstring bccloseTag
let ignoreCommentContent : Parser<unit,unit> = skipManyTillEx (skipAnyChar) (choice [pbcopen; pbcclose] |>> fun x -> ())
let ignoreSubComment : Parser<unit,unit> = ublockComment
let commentContent : Parser<unit,unit> = skipMany (choice [ignoreCommentContent; ignoreSubComment])
do ublockCommentImpl := between (pbcopen) (pbcclose) (commentContent) |>> fun c -> ()
do test (skipManyTillEx (pchar 'a' |>> fun c -> ()) (pchar 'b') >>. (restOfLine true)) "aaaabcccc"
// do test ublockComment "/**/"
//do test ublockComment "/* This is a comment \n With multiple lines. */"
do test ublockComment "/* Bla bla bla /* nested bla bla */ more outer bla bla */"
let's take a look at your questions...
1. Is there any reason, why the approach I have chosen cannot work?
Your approach can definitely work, you just have to weed out the bugs.
2. Can anyone see a problem with the way I implemented skipManyTillEx?
No. Your implementation looks OK. It's just the combination of skipMany and skipManyTillEx that's the problem.
let ignoreCommentContent : Parser<unit,unit> = skipManyTillEx (skipAnyChar) (choice [pbcopen; pbcclose] |>> fun x -> ())
let commentContent : Parser<unit,unit> = skipMany (choice [ignoreCommentContent; ignoreSubComment])
skipMany in commentContent runs until ignoreCommentContent and ignoreSubComment both fail. But ignoreCommentContent is implemented using your skipManyTillEx, which is implemented in a way that it could succeed without consuming input. This means that the outer skipMany would not be able to determine when to stop because if no input is consumed, it doesn't know whether a subsequent parser has failed or simply didn't consume anything.
This is why it's required that every parser below a many parser has to consume input. Your skipManyTillEx might not, that's what the error message is trying to tell you.
To fix it, you have to implement a skipMany1TillEx, that consumes at least one element itself.
3. Does anyone see, how to fix the parser such, that this "many ... " error message goes away?
How about this approach?
open FParsec
open System
/// Type abbreviation for parsers without user state.
type Parser<'a> = Parser<'a, Unit>
/// Skips C-style multiline comment /*...*/ with arbitrary nesting depth.
let (comment : Parser<_>), commentRef = createParserForwardedToRef ()
/// Skips any character not beginning of comment end marker */.
let skipCommentChar : Parser<_> =
notFollowedBy (skipString "*/") >>. skipAnyChar
/// Skips anx mix of nested comments or comment characters.
let commentContent : Parser<_> =
skipMany (choice [ comment; skipCommentChar ])
// Skips C-style multiline comment /*...*/ with arbitrary nesting depth.
do commentRef := between (skipString "/*") (skipString "*/") commentContent
/// Prints the strings p skipped over on the console.
let printSkipped p =
p |> withSkippedString (printfn "Skipped: \"%s\" Matched: \"%A\"")
[
"/*simple comment*/"
"/** special / * / case **/"
"/*testing /*multiple*/ /*nested*/ comments*/ not comment anymore"
"/*not closed properly/**/"
]
|> List.iter (fun s ->
printfn "Test Case: \"%s\"" s
run (printSkipped comment) s |> printfn "Result: %A\n"
)
printfn "Press any key to exit..."
Console.ReadKey true |> ignore
By using notFollowedBy to only skip characters that are not part of a comment end marker (*/), there is no need for nested many parsers.
Hope this helps :)
Finally found a way to fix the many problem.
Replaced my custom skipManyTillEx with another custom function I called skipManyTill1Ex.
skipManyTill1Ex, in contrast to the previous skipManyTillEx only succeeds if it parsed 1 or more p successfully.
I expected the test for the empty comment /**/ to fail for this version but it works.
...
let skipManyTill1Ex (p : Parser<_,_>) (endp : Parser<_,_>) : Parser<unit,unit> =
fun stream ->
let tryParse (p : Parser<_,_>) (stm : CharStream<unit>) : bool =
let spre = stm.State
let reply = p stm
match reply.Status with
| ReplyStatus.Ok ->
stream.BacktrackTo spre
true
| _ ->
stream.BacktrackTo spre
false
let initialState = stream.State
let mutable preply = preturn () stream
let mutable looping = true
let mutable matchCounter = 0
while (not (tryParse endp stream)) && looping do
preply <- p stream
match preply.Status with
| ReplyStatus.Ok ->
matchCounter <- matchCounter + 1
()
| _ -> looping <- false
match (preply.Status, matchCounter) with
| (ReplyStatus.Ok, c) when (c > 0) -> preply
| (_,_) ->
let myReply = Reply(Error, mergeErrors preply.Error (messageError "skipManyTill1Ex failed") )
stream.BacktrackTo initialState
myReply
let ublockComment, ublockCommentImpl = createParserForwardedToRef()
let bcopenTag = "/*"
let bccloseTag = "*/"
let pbcopen = pstring bcopenTag
let pbcclose = pstring bccloseTag
let ignoreCommentContent : Parser<unit,unit> = skipManyTill1Ex (skipAnyChar) (choice [pbcopen; pbcclose] |>> fun x -> ())
let ignoreSubComment : Parser<unit,unit> = ublockComment
let commentContent : Parser<unit,unit> = skipMany (choice [ignoreCommentContent; ignoreSubComment])
do ublockCommentImpl := between (pbcopen) (pbcclose) (commentContent) |>> fun c -> ()
do test (skipManyTillEx (pchar 'a' |>> fun c -> ()) (pchar 'b') >>. (restOfLine true)) "aaaabcccc"
do test ublockComment "/**/"
do test ublockComment "/* This is a comment \n With multiple lines. */"
do test ublockComment "/* Bla bla bla /* nested bla bla */ more outer bla bla */"
I am trying to parse a list of tokens with FParsec, where each token is either a block of text or a tag - for example:
This is a {type of test} test, and it {succeeds or fails}
Here is the parser:
type Parser<'t> = Parser<'t, unit>
type Token =
| Text of string
| Tag of string
let escape fromString toString : Parser<_> =
pstring fromString |>> (fun c -> toString)
let content : Parser<_> =
let contentNormal = many1Satisfy (fun c -> c <> '{' && c <> '}')
let openBraceEscaped = escape "{{" "{"
let closeBraceEscaped = escape "}}" "}"
let contentEscaped = openBraceEscaped <|> closeBraceEscaped
stringsSepBy contentNormal contentEscaped
let ident : Parser<_> =
let isIdentifierFirstChar c = isLetter c || c = '_'
let isIdentifierChar c = isLetter c || isDigit c || c = '_'
spaces >>. many1Satisfy2L isIdentifierFirstChar isIdentifierChar "identifier" .>> spaces
let text = content |>> Text
let tag =
ident |> between (skipString "{") (skipString "}")
|>> Tag
let token = text <|> tag
let tokens = many token .>>. eof
the following tests work:
> run token "abc def" ;;
val it : ParserResult<Token,unit> = Success: Text "abc def"
> run token "{abc def}" ;;
val it : ParserResult<Token,unit> = Success: Tag "abc def"
but trying to run tokens results in an exception:
> run tokens "{abc} def" ;;
System.InvalidOperationException: (Ln: 1, Col: 10): The combinator 'many' was
applied to a parser that succeeds without consuming input and without
changing the parser state in any other way. (If no exception had been raised,
the combinator likely would have entered an infinite loop.)
I've gone over this stackoverflow question but nothing I've tried works. I even added the following, but I get the same exception:
let tokenFwd, tokenRef = createParserForwardedToRef<Token, unit>()
do tokenRef := choice [tag; text]
let readEndOfInput : Parser<unit, unit> = spaces >>. eof
let readExprs = many tokenFwd
let readExprsTillEnd = readExprs .>> readEndOfInput
run readExprsTillEnd "{abc} def" // System.InvalidOperationException ... The combinator 'many' was applied ...
I believe the problem is stringsSepBy in content, but I can't figure out any other way to get a string with the escaped items
Any help would be much appreciated - I have been going through this for a couple days now and can't figure it out.
stringsSepBy accepts zero strings, causing token to accept an empty string, causing many to complain.
I changed it to the following to verify that that was the line you need to work on.
many1 (contentNormal <|> contentEscaped) |>> fun l -> String.concat "" l
Also I got away from stringsSepBy contentNormal contentEscaped, because that says you need to match contentNormals with contentEscapeds in between them. So a{{b}}c is ok, but {{b}}, {{b}}c and a{{b}} will fail.
notEmpty can be used to consume input. If you're not consuming any input but letting the parser succeed then the "current position" of the parser is not moved forward, so when a statement doing that is inside a many it would go into an infinite loop without that exception. stringsSepBy is succeeding and parsing zero elements, you could use notEmpty to fail it if it gets zero elements:
stringsSepBy contentNormal contentEscaped |> notEmpty
Also, I tried to get your full example to parse, the tags can include spaces so you need to allow ident to include spaces to match that:
let isIdentifierChar c = isLetter c || isDigit c || c = '_' || c = ' '
Another little adjustment would be to only return a Token list rather than Token list * unit tuple (unit is the result of eof):
let tokens = many token .>> eof
I've started learning FParsec. It has a very flexible way to parse numbers; I can provide a set of number formats I want to use:
type Number =
| Numeral of int
| Decimal of float
| Hexadecimal of int
| Binary of int
let numberFormat = NumberLiteralOptions.AllowFraction
||| NumberLiteralOptions.AllowHexadecimal
||| NumberLiteralOptions.AllowBinary
let pnumber =
numberLiteral numberFormat "number"
|>> fun num -> if num.IsHexadecimal then Hexadecimal (int num.String)
elif num.IsBinary then Binary (int num.String)
elif num.IsInteger then Numeral (int num.String)
else Decimal (float num.String)
However, the language I'm trying to parse is a bit strange. A number could be numeral (non-negative int), decimal (non-negative float), hexadecimal (with prefix #x) or binary (with prefix #b):
numeral: 0, 2
decimal: 0.2, 2.0
hexadecimal: #xA04, #x611ff
binary: #b100, #b001
Right now I have to do parsing twice by substituting # by 0 (if necessary) to make use of pnumber:
let number: Parser<_, unit> =
let isDotOrDigit c = isDigit c || c = '.'
let numOrDec = many1Satisfy2 isDigit isDotOrDigit
let hexOrBin = skipChar '#' >>. manyChars (letter <|> digit) |>> sprintf "0%s"
let str = spaces >>. numOrDec <|> hexOrBin
str |>> fun s -> match run pnumber s with
| Success(result, _, _) -> result
| Failure(errorMsg, _, _) -> failwith errorMsg
What is a better way of parsing in this case? Or how can I alter FParsec's CharStream to be able to make conditional parsing easier?
Parsing numbers can be pretty messy if you want to generate good error messages and properly check for overflows.
The following is a simple FParsec implementation of your number parser:
let numeralOrDecimal : Parser<_, unit> =
// note: doesn't parse a float exponent suffix
numberLiteral NumberLiteralOptions.AllowFraction "number"
|>> fun num ->
// raises an exception on overflow
if num.IsInteger then Numeral(int num.String)
else Decimal(float num.String)
let hexNumber =
pstring "#x" >>. many1SatisfyL isHex "hex digit"
|>> fun hexStr ->
// raises an exception on overflow
Hexadecimal(System.Convert.ToInt32(hexStr, 16))
let binaryNumber =
pstring "#b" >>. many1SatisfyL (fun c -> c = '0' || c = '1') "binary digit"
|>> fun hexStr ->
// raises an exception on overflow
Binary(System.Convert.ToInt32(hexStr, 2))
let number =
choiceL [numeralOrDecimal
hexNumber
binaryNumber]
"number literal"
Generating good error messages on overflows would complicate this implementation a bit, as you would ideally also need to backtrack after the error, so that the error position ends up at the start of the number literal (see the numberLiteral docs for an example).
A simple way to gracefully handle possible overflow exception is to use a little exception handling combinator like the following:
let mayThrow (p: Parser<'t,'u>) : Parser<'t,'u> =
fun stream ->
let state = stream.State
try
p stream
with e -> // catching all exceptions is somewhat dangerous
stream.BacktrackTo(state)
Reply(FatalError, messageError e.Message)
You could then write
let number = mayThrow (choiceL [...] "number literal")
I'm not sure what you meant to say with "alter FParsec's CharStream to be able to make conditional parsing easier", but the following sample demonstrates how you could write a low-level implementation that only uses the CharStream methods directly.
type NumberStyles = System.Globalization.NumberStyles
let invariantCulture = System.Globalization.CultureInfo.InvariantCulture
let number: Parser<Number, unit> =
let expectedNumber = expected "number"
let inline isBinary c = c = '0' || c = '1'
let inline hex2int c = (int c &&& 15) + (int c >>> 6)*9
let hexStringToInt (str: string) = // does no argument or overflow checking
let mutable n = 0
for c in str do
n <- n*16 + hex2int c
n
let binStringToInt (str: string) = // does no argument or overflow checking
let mutable n = 0
for c in str do
n <- n*2 + (int c - int '0')
n
let findIndexOfFirstNonNull (str: string) =
let mutable i = 0
while i < str.Length && str.[i] = '0' do
i <- i + 1
i
let isHexFun = id isHex // tricks the compiler into caching the function object
let isDigitFun = id isDigit
let isBinaryFun = id isBinary
fun stream ->
let start = stream.IndexToken
let cs = stream.Peek2()
match cs.Char0, cs.Char1 with
| '#', 'x' ->
stream.Skip(2)
let str = stream.ReadCharsOrNewlinesWhile(isHexFun, false)
if str.Length <> 0 then
let i = findIndexOfFirstNonNull str
let length = str.Length - i
if length < 8 || (length = 8 && str.[i] <= '7') then
Reply(Hexadecimal(hexStringToInt str))
else
stream.Seek(start)
Reply(Error, messageError "hex number literal is too large for 32-bit int")
else
Reply(Error, expected "hex digit")
| '#', 'b' ->
stream.Skip(2)
let str = stream.ReadCharsOrNewlinesWhile(isBinaryFun, false)
if str.Length <> 0 then
let i = findIndexOfFirstNonNull str
let length = str.Length - i
if length < 32 then
Reply(Binary(binStringToInt str))
else
stream.Seek(start)
Reply(Error, messageError "binary number literal is too large for 32-bit int")
else
Reply(Error, expected "binary digit")
| c, _ ->
if not (isDigit c) then Reply(Error, expectedNumber)
else
stream.SkipCharsOrNewlinesWhile(isDigitFun) |> ignore
if stream.Skip('.') then
let n2 = stream.SkipCharsOrNewlinesWhile(isDigitFun)
if n2 <> 0 then
// we don't parse any exponent, as in the other example
let mutable result = 0.
if System.Double.TryParse(stream.ReadFrom(start),
NumberStyles.AllowDecimalPoint,
invariantCulture,
&result)
then Reply(Decimal(result))
else
stream.Seek(start)
Reply(Error, messageError "decimal literal is larger than System.Double.MaxValue")
else
Reply(Error, expected "digit")
else
let decimalString = stream.ReadFrom(start)
let mutable result = 0
if System.Int32.TryParse(stream.ReadFrom(start),
NumberStyles.None,
invariantCulture,
&result)
then Reply(Numeral(result))
else
stream.Seek(start)
Reply(Error, messageError "decimal number literal is too large for 32-bit int")
While this implementation parses hex and binary numbers without the help of system methods, it eventually delegates the parsing of decimal numbers to the Int32.TryParse and Double.TryParse methods.
As I said: it's messy.