open FParsec
// Parse an integer
let pint : Parser<int, unit> = pint32
// Parse a floating-point number
let pfloat : Parser<float, unit> = pfloat
// Parse a specific string
let pHello : Parser<string, unit> = pstring "hello"
// Running a parser
let result = run pint "42"
match result with
| Success(value, _, _) -> printfn "Parsed: %d" value
| Failure(msg, _, _) -> printfn "Error: %s" msg
open FParsec
// Sequence: parse one thing then another
let pPoint : Parser<float * float, unit> =
pchar '(' >>. pfloat .>> pchar ',' .>>. pfloat .>> pchar ')'
// run pPoint "(3.5,4.2)" => Success((3.5, 4.2))
// Choice: try alternatives
let pBool : Parser<bool, unit> =
(stringReturn "true" true) <|> (stringReturn "false" false)
// Many: zero or more
let pDigits : Parser<char list, unit> = many digit
// SepBy: items separated by a delimiter
let pCsvInts : Parser<int list, unit> = sepBy pint32 (pchar ',')
// Between: surrounded by delimiters
let pBracketed : Parser<int list, unit> =
between (pchar '[') (pchar ']') pCsvInts
// run pBracketed "[1,2,3]" => Success([1; 2; 3])
open FParsec
let isIdentifierFirstChar c = isLetter c || c = '_'
let isIdentifierChar c = isLetter c || isDigit c || c = '_'
let pIdentifier : Parser<string, unit> =
many1Satisfy2L isIdentifierFirstChar isIdentifierChar "identifier"
let pKeyword (s: string) : Parser<unit, unit> =
pstring s >>. notFollowedBy (satisfy isIdentifierChar) >>. spaces
// Keywords with reserved word checking
let keywords = Set.ofList ["let"; "if"; "then"; "else"; "true"; "false"]
let pIdent : Parser<string, unit> =
pIdentifier >>= fun id ->
if Set.contains id keywords then
fail (sprintf "'%s' is a reserved keyword" id)
else
preturn id
open FParsec
type Expr =
| Number of float
| BinOp of string * Expr * Expr
| UnaryMinus of Expr
| Variable of string
let pExpr, pExprRef = createParserForwardedToRef<Expr, unit>()
let pNumber : Parser<Expr, unit> = pfloat |>> Number
let pVariable : Parser<Expr, unit> =
many1Satisfy2L isLetter isLetterOrDigit "variable" |>> Variable
let pAtom : Parser<Expr, unit> =
pNumber
<|> pVariable
<|> between (pchar '(' >>. spaces) (pchar ')' >>. spaces) pExpr
let opp = new OperatorPrecedenceParser<Expr, unit, unit>()
opp.TermParser <- pAtom .>> spaces
// Binary operators (left-associative)
opp.AddOperator(InfixOperator("+", spaces, 1, Associativity.Left,
fun x y -> BinOp("+", x, y)))
opp.AddOperator(InfixOperator("-", spaces, 1, Associativity.Left,
fun x y -> BinOp("-", x, y)))
opp.AddOperator(InfixOperator("*", spaces, 2, Associativity.Left,
fun x y -> BinOp("*", x, y)))
opp.AddOperator(InfixOperator("/", spaces, 2, Associativity.Left,
fun x y -> BinOp("/", x, y)))
// Exponentiation (right-associative)
opp.AddOperator(InfixOperator("^", spaces, 3, Associativity.Right,
fun x y -> BinOp("^", x, y)))
// Unary minus (prefix)
opp.AddOperator(PrefixOperator("-", spaces, 4, true,
fun x -> UnaryMinus x))
pExprRef.Value <- opp.ExpressionParser
// run opp.ExpressionParser "2 + 3 * 4" => BinOp("+", Number 2, BinOp("*", Number 3, Number 4))
open FParsec
type JsonValue =
| JsonNull
| JsonBool of bool
| JsonNumber of float
| JsonString of string
| JsonArray of JsonValue list
| JsonObject of (string * JsonValue) list
let pJsonValue, pJsonValueRef = createParserForwardedToRef<JsonValue, unit>()
let ws = spaces
let pNull = stringReturn "null" JsonNull .>> ws
let pTrue = stringReturn "true" (JsonBool true) .>> ws
let pFalse = stringReturn "false" (JsonBool false) .>> ws
let pBoolVal = pTrue <|> pFalse
let pJsonNumber = pfloat .>> ws |>> JsonNumber
let pStringLiteral =
let normalChar = satisfy (fun c -> c <> '\\' && c <> '"')
let escapedChar =
pchar '\\' >>. (anyOf "\\\"nrt" |>> function
| 'n' -> '\n' | 'r' -> '\r' | 't' -> '\t' | c -> c)
between (pchar '"') (pchar '"')
(manyChars (normalChar <|> escapedChar)) .>> ws
let pJsonString = pStringLiteral |>> JsonString
let pJsonArray =
between (pchar '[' >>. ws) (pchar ']' >>. ws)
(sepBy pJsonValue (pchar ',' >>. ws)) |>> JsonArray
let pKeyValue =
pStringLiteral .>> pchar ':' .>> ws .>>. pJsonValue
let pJsonObject =
between (pchar '{' >>. ws) (pchar '}' >>. ws)
(sepBy pKeyValue (pchar ',' >>. ws)) |>> JsonObject
pJsonValueRef.Value <-
pNull <|> pBoolVal <|> pJsonNumber <|> pJsonString <|> pJsonArray <|> pJsonObject
open FParsec
// User state tracks indentation level
type IndentState = { IndentLevel: int }
let pIndented (p: Parser<'a, IndentState>) : Parser<'a, IndentState> =
getUserState >>= fun state ->
let expectedIndent = state.IndentLevel * 4
skipManyMinMaxSatisfy expectedIndent expectedIndent (fun c -> c = ' ')
>>. p
let pBlock (p: Parser<'a, IndentState>) : Parser<'a list, IndentState> =
updateUserState (fun s -> { s with IndentLevel = s.IndentLevel + 1 })
>>. many1 (pIndented p)
.>> updateUserState (fun s -> { s with IndentLevel = s.IndentLevel - 1 })
