PEG.ml

module Interval = struct
  type 'a t = {start: 'a; finish: 'a}
end



module Position = struct
  type t = {line: int; column: int}
end

module Location = struct
  type t = {
    file_name: string option;
    source: string;
    interval: Position.t Interval.t;
  }

  let create source char_start char_finish =
    (* TODO compute line/column correctly from char *)
    {
      file_name=None;
      source;
      interval=Interval.({
        start=Position.({line=0; column=char_start});
        finish=Position.({line=0; column=char_finish});
      })
    }
end

module Tree = struct
  type t = {name: string option; children: t list; location: Location.t}

  let create ?name ?(children=[]) location =
    {name; children; location}
end


module CodePoint = struct
  type t = int
end

module Pattern = struct
  module CharacterClassItem = struct
    type t =
      | Character of CodePoint.t
      | CharacterRange of CodePoint.t Interval.t
  end
  type t =
    | CharacterRange of CodePoint.t Interval.t
    | Sequence of t list
    | Repetition of t * int Interval.t
    | PrioritizedChoice of t list
    | NotPredicate of t
    | Reference of string

  type t =
    | Character of CodePoint.t
    | Sequence of t list
    | ZeroOrMore of t
    | PrioritizedChoice of t list
    | NotPredicate of t
    | Reference of string
  (*
  type t =
    | AnyCharacter
    | LiteralString of string
    | CharacterClass of CharacterClassItem.t list
    | Repetition of t * int option Interval.t
  (*| ZeroOrMore of t              x{0,}  *)
  (*| OneOrMore of t               x{1,}  *)
  (*| Optional of t                x{0,1} *)
    | Sequence of t list
    | PrioritizedChoice of t list
    | NotPredicate of t
  (*| AndPredicate of t *)
    | Reference of string
    *)

  let parse pattern source = match pattern with
    | LiteralString string ->
        Tree.create (Location.create source 0 3)
    | _ -> assert false
end



module StringMap = Map.Make (String)

module Grammar = struct
  type t = Pattern.t StringMap.t
end

module Language = struct
  module SemanticAction = struct
    type 'a t = Tree.t -> 'a
  end

  type 'a t = (Pattern.t * 'a SemanticAction.t) StringMap.t
end