Source

ocaml-lib / dcg / matcher.ml

(*
 * Matcher: simple lexer pattern.
 * Copyright (C) 2006
 * Dmitri Boulytchev, St.Petersburg State University
 * 
 * This software is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License version 2, as published by the Free Software Foundation.
 * 
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * 
 * See the GNU Library General Public License version 2 for more details
 * (enclosed in the file COPYING).
 *)

open Dcg
open Printf

module Token =
  struct

    type t = string * Msg.Coord.t

    let toString (t, c) = sprintf "%s at %s" t (Msg.Coord.toString c)

    let loc (t, c) = Msg.Locator.Interval (c, ((fst c), (snd c)+(String.length t)-1))
    let repr       = fst

  end

let shiftPos (line, col) s b n =
  let rec inner i (line, col) =
    if i = n 
    then (line, col)
    else
      match s.[i] with
      | '\n' -> inner (i+1) (line+1, 1)
      | _    -> inner (i+1) (line, col+1)
  in
  inner b (line, col)

class str skip s p coord =
  object (self)
    method params = (s, p, coord)

    method skip =
      if Str.string_match skip s p
      then
	let m = Str.matched_string s in
	let len = String.length m in
	new str skip s (p+len) (shiftPos coord m 0 len)
      else
	new str skip s p coord

    method shift m =
      let len = String.length m in
      new str skip s (p+len) (shiftPos coord m 0 len)
  end

let str_of_string skip s = new str skip s 0 (1,1)

class ['ctx,'res] get (name : string) (regexp : Str.regexp) (f : Token.t -> 'res) (ctx : 'ctx) (str : str) =
  object (self)
    val mutable state = `Begin

    method next =
      match state with
      | `Begin ->
	  state <- `End;
	  let str = str # skip in
	  let s, p, coord = str # params in
	  if Str.string_match regexp s p
	  then
	    let m = Str.matched_string s in
	    Parsed (ctx, f (m, coord), str # shift m)
	  else
	    Failed [Msg.make (sprintf "%s expected" name) [||] (Msg.Locator.Point coord)]
      | `End -> Failed []
  end

let get = new get

class ['ctx] look (kw : string) (ctx : 'ctx) (str : str) =
  object (self)
    val mutable state = `Begin
	
    method next = 
      match state with
      | `Begin ->
	  state <- `End;
	  let str = str # skip in
	  let s, p, coord = str # params in
	  (try 
	    let l = String.length kw in
	    let m = String.sub s p l in
	    if kw = m 
	    then Parsed (ctx, (m, coord), str # shift m)
	    else Failed [Msg.make (sprintf "%s expected" kw) [||] (Msg.Locator.Point coord)]
	  with Invalid_argument _ -> Failed [Msg.make (sprintf "%s expected" kw) [||] (Msg.Locator.Point coord)])
      | `End -> Failed []
  end

let look = new look

class ['ctx] eof (ctx : 'ctx) (str : str) =
  object
    val mutable state = `Begin

    method next =
      match state with
      | `Begin ->
	  state <- `End;
	  let str = str # skip in
	  let s, p, coord = str # params in
	  if p = String.length s
	  then Parsed (ctx, ("<EOF>", coord), str)
	  else Failed [Msg.make "<EOF> expected" [||] (Msg.Locator.Point coord)]
      | `End -> Failed []
  end

let eof = new eof


type ('ctx,'res) parse = ('ctx, 'res, str, Msg.t) Dcg.parse

(*
class virtual ['a] matcher (make : string -> int -> Msg.Coord.t -> 'a) s p coord = 
  object (self)

    method virtual skip : int * Msg.Coord.t

    method get (name : string) regexp =
      LOG (printf "Trying %s at %s\n" name (sub s p (min 10 (length s - p)))); 
      let p, coord = self#skip in
      if string_match regexp s p
      then begin
	let m = matched_string s in
	LOG (printf "Ok, repr=%s\n" m);
	let p = p + length m in	
	Parsed ((m, coord), make s p (shiftPos coord m 0 (length m)))
      end
      else 
	Failed [Msg.make (sprintf "%s expected" name) [||] (Msg.Locator.Point coord)]

    method look str = 
      let p, coord = self#skip in
      try 
	let l = String.length str in
	let m = String.sub s p l in
	if str = m 
	then Parsed ((m, coord), make s (p+l) (shiftPos coord m 0 (length m)))
	else Failed [Msg.make (sprintf "%s expected" str) [||] (Msg.Locator.Point coord)]
      with Invalid_argument _ -> Failed [Msg.make (sprintf "%s expected" str) [||] (Msg.Locator.Point coord)]

    method getEOF = 
      let p, coord = self#skip in
      LOG (printf "Trying <EOF> at %s\n" (sub s p (min 10 (length s - p)))); 
      if p = length s 
      then Parsed (("<EOF>", coord), make s p coord)
      else Failed [Msg.make "<EOF> expected" [||] (Msg.Locator.Point coord)]

    method getFIRST   = self#look ""
    method getLAST    = 
      (
       Parsed (("", coord), make s p coord) : 
	 ((string * Msg.Coord.t) * 'a, Msg.t) Ostap.tag
      )

  end
*)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.