PollRobots

type Expression =
| Terminal of string
| NonTerminal of string
| Epsilon
| Sequence of Expression list
| Choice of Expression list
| ZeroOrMore of Expression
| OneOrMore of Expression
| Optional of Expression
| And of Expression

PollRobots

let printPeg expr =
    let rec pegToString = function
    | Terminal x -> "\"" + x + "\""
    | NonTerminal x -> x
    | Epsilon -> "<epsilon>"
    | Sequence x -> List.map pegToString >> List.reduce (fun a b -> a + " " + b) <| x
    | Choice x -> List.map pegToString >> List.reduce (fun a b -> a + " / " + b) <| x
    | ZeroOrMore x -> pegToString x + "*"
    | OneOrMore x -> pegToString x + "+"
    | Optional x -> pegToString x + "?"

PollRobots

let rec pegToString expr =
    let pegToStringParen = function
    | Terminal _ | NonTerminal _ | Epsilon as x -> pegToString x
    | x -> "(" + pegToString x + ")"

    match expr with
    | Terminal x -> "\"" + x + "\""
    | NonTerminal x -> x
    | Epsilon -> "<epsilon>"
    | Sequence x -> List.map pegToStringParen >> List.reduce (fun a b -> a + " " + b) <| x

PollRobots

type ParseResult =
| TerminalSymbol of string
| Production of ParseResult list
| EmptyMatch
| Unmatched

PollRobots

let parseExpression (grammar:Map<string,Expression>) start (input:string) =
    let rec parse offset = function
    | Terminal x -> 
        let e = offset + x.Length - 1
        if e < input.Length && input.[offset..e] = x then (TerminalSymbol x, e + 1) else (Unmatched, offset)
    | NonTerminal x -> parse offset grammar.[x]
    | Epsilon -> if offset = input.Length then (EmptyMatch, offset) else (Unmatched, offset)

PollRobots

    | Sequence x ->
        let rec parseList lst off =
            seq {
                if List.isEmpty lst then ()
                else
                    match parse off <| List.head lst with
                    | (Unmatched, _) as y -> yield y
                    | (y, z) -> yield (y, z)
                                yield! parseList (List.tail lst) z
            }

PollRobots

    | ZeroOrMore x ->
        let rec parseList off =
            seq {
                match parse off x with
                | (Unmatched, _) -> ()
                | (y, z) -> yield (y, z)
                            yield! parseList z
            }
        let s = List.ofSeq <| parseList offset
        if List.isEmpty s then (EmptyMatch, offset) 

PollRobots

let g = Map.ofList [("bool", Choice [Terminal "true"; Terminal "false"]);
                    ("paren", Sequence [Terminal "("; NonTerminal "expr"; Terminal ")"]);
                    ("not", Sequence [Terminal "!"; NonTerminal "expr"]);
                    ("atom", Choice [NonTerminal "bool"; NonTerminal "paren"; NonTerminal "not"]);
                    ("and", Sequence [NonTerminal "atom"; Optional (Sequence [Terminal "&"; NonTerminal "and"])]);
                    ("or", Sequence [NonTerminal "and"; Optional (Sequence [Terminal "|"; NonTerminal "or"])]);
                    ("expr", NonTerminal "or");
                    ("start", Sequence [NonTerminal "expr"; Epsilon])]

PollRobots

type ParseResult<'a> =
| Parsed of 'a
| TerminalSymbol of string
| Production of ParseResult<'a> list
| EmptyMatch
| Unmatched

PollRobots

type GrammarRule<'a>(prod:Expression, func:(string -> ParseResult<'a> -> ParseResult<'a>)) =
    member this.Prod = prod
    member this.Func = func

let parseExpression (grammar:Map<string,GrammarRule<'a>>) start (input:string) =