ParserGenerator

example.fs

open PEGParser
let size x =
    match x with
    | Value((_, _, ResultRepeat(lis))) -> lis.Length
    | _ -> 0

[<EntryPoint>]
let main argv =
    System.Console.WriteLine(size (parse "aaaaaaaaaa" [|Repeat(Chars(['a']))|]))
    0 // return an integer exit code

Memoization.fs

module Memoization

module Detail =
    type Optional<'a> = None | Value of 'a
    let GetData<'T, 'U when 'T:equality> (target: 'T) (dic: System.Collections.Generic.List<('T*'U)>)=
        let mutable ret = None
        for (x, y) in dic do if x=target then ret<-Value(y) else ()
        ret

type Memoization<'T,'U when 'T:equality>()=
    let d = new System.Collections.Generic.List<('T*'U)>()
    member this.Run (p: ('T->'U)->'T->'U) ( x: 'T) =
        match Detail.GetData x d with
        | Detail.None ->
            let ret = p (this.Run p) x
            d.Add((x, ret))
            ret
        | Detail.Value(v) -> v
    
let make_memoization f =
    let m = Memoization()
    m.Run f

PEGParser.fs

module PEGParser

type optional<'T> = None | Value of 'T

type expression =
    | FreeIndex of int
    | Chars of char list
    | Null
    | Sequence of expression * expression
    | Selection of expression * expression
    | Repeat of expression
    | Ignorable of expression
    | AndPredicate of expression
    | NotPredicate of expression

type result =
    | ResultIndex of int * result
    | ResultChar of char
    | ResultNull
    | ResultSequence of (int * int * result) * (int * int * result)
    | ResultRepeat of (int * int * result) list
    | ResultIgnorable of optional<result>
    | ResultAndPredicate of int * int * result
    | ResultNotPredicate

module Detail =
    let rec search (c: char) (lis: char list) =
        match lis with
        | []-> None
        | v::next -> if c = v then Value(v) else search c next
    
    let parse = Memoization.make_memoization (fun func (t: string * int * expression array * expression) ->
        match t with
        | (str, index, exprs, expr) ->
            match expr with
            | FreeIndex(v) ->
                match func((str, index, exprs, exprs.[v])) with
                | None -> None
                | Value((first, last, res)) -> Value((first, last, ResultIndex(v, res)))
            | Chars(lis) -> 
                if index = str.Length then None else 
                    match search (str.Chars(index)) lis with
                    | None -> None
                    | Value(c) -> Value((index, index+1, ResultChar(c)))
            | Null -> Value((index, index, ResultNull))
            | Sequence(expr1, expr2) ->
                match func(str, index, exprs, expr1) with
                | None -> None
                | Value((first, last, res1)) ->
                    match func((str, last, exprs, expr2)) with
                    | None -> None
                    | Value((f, l, res2)) -> Value(first, l, ResultSequence((first, last, res1), (last, l, res2)))
            | Selection(expr1, expr2) ->
                match func(str, index, exprs, expr1) with
                | None -> func(str, index, exprs, expr2)
                | x -> x
            | Repeat(expr) ->
                match func(str, index, exprs, expr) with
                | None -> Value((index, index, ResultRepeat([])))
                | Value((first, last, res)) ->
                    match func(str, last, exprs, Repeat(expr)) with
                    | None -> None
                    | Value((f, l, ResultRepeat(lis))) -> Value((first, l, ResultRepeat((first, last, res)::lis)))
                    | _ -> None
            | Ignorable(expr) ->
                match func(str, index, exprs, expr) with
                | None -> Value((index, index, ResultIgnorable(None)))
                | Value((first, last, res)) -> Value((first, last, ResultIgnorable(Value(res))))
            | AndPredicate(expr) ->
                match func(str, index, exprs, expr) with
                | None -> None
                | Value((first, last, res)) -> Value((index, index, ResultAndPredicate(first, last, res)))
            | NotPredicate(expr) ->
                match func(str, index, exprs, expr) with
                | None -> Value((index, index, ResultNotPredicate))
                | _ -> None)

let parse (str: string) (exprs: expression array) =
    Detail.parse (str, 0, exprs, exprs.[0])