Permalink
Browse files

first commit

  • Loading branch information...
0 parents commit e63fcf235eecfde5f1244e5f42f9abd4d129f539 @johnlepikhin committed Aug 21, 2011
Showing with 622 additions and 0 deletions.
  1. +6 −0 META
  2. +46 −0 README
  3. +4 −0 _tags
  4. +71 −0 myocamlbuild.ml
  5. +127 −0 rex.ml
  6. +22 −0 rex.mli
  7. +206 −0 rex_apply.ml
  8. +118 −0 rex_parser.ml
  9. +22 −0 rex_type.ml
6 META
@@ -0,0 +1,6 @@
+name="rex"
+version="1.0.0"
+description="LWT based simple regular expressions for streams matching"
+archive(byte)="rex.cma"
+archive(native)="rex.cmxa"
+requires = "lwt"
46 README
@@ -0,0 +1,46 @@
+Regexp matching on character streams. The main idea is to provide a simple regular expressions library which takes characters not from string but from function "get":
+
+val get: unit -> char Lwt.t
+
+Primitives supported:
+ "c" Matches character "c"
+ "[abc]" Matches any of listed characters
+ "[^abc]" Matches any of NOT listed characters
+ "[\\^\\]]" Matches "^" or "]"
+ "[^\\^\\]]" Matches NOT "^" and NOT "]"
+ "(grp)" Grouping. Matched group can be extracted from result using function "nth".
+ "." Matches any character. Be careful, Rex regexps have no looking-forward algorithms. Regexps such as ".+a" will not ever stop.
+
+Repetition primitives:
+ "c" Matches exactly one character "c"
+ "c?" Matches zero or one "c"
+ "c*" Matches zero or more of "c"'s
+ "c+" Matches one or more of "c"'s
+ "c{2,5}" Matches 2..5 of "c"'s
+
+Usage example:
+
+let regexp = Rex.regexp "GET ([^ ]+) HTTP"
+
+let get =
+ let s = "GET /some/uri HTTP/1.1\n" in
+ let pos = ref 0 in
+ fun () ->
+ let r = s.[pos] in
+ incr pos;
+ Lwt.return r
+
+let match =
+ lwt r = Rex.apply ~get regexp in
+ let result =
+ match r with
+ | None ->
+ "no match"
+ | Some r ->
+ let uri = Rex.nth r 0 in
+ "URI=" ^ uri
+ in
+ Printf.printf "result is: %s\n" result
+
+let _ =
+ Lwt_unix.run match
4 _tags
@@ -0,0 +1,4 @@
+<*.ml>: syntax_camlp4o, pkg_lwt, pkg_lwt.syntax
+<*.mli>: syntax_camlp4o, pkg_lwt, pkg_lwt.syntax
+<*.cmxa>: pkg_lwt, pkg_lwt.unix
+<*.cma>: pkg_lwt, pkg_lwt.unix
@@ -0,0 +1,71 @@
+open Printf
+open Ocamlbuild_plugin
+
+(* +-----------------------------------------------------------------+
+ | Ocamlfind |
+ +-----------------------------------------------------------------+ *)
+
+(* these functions are not really officially exported *)
+let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
+let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
+
+let split s ch =
+ let x = ref [] in
+ let rec go s =
+ let pos = String.index s ch in
+ x := (String.before s pos)::!x;
+ go (String.after s (pos + 1))
+ in
+ try
+ go s
+ with Not_found -> !x
+
+let split_nl s = split s '\n'
+
+ let before_space s =
+ try
+ String.before s (String.index s ' ')
+ with Not_found -> s
+
+(* this lists all supported packages *)
+let installed_packages () = List.map before_space (split_nl & run_and_read "ocamlfind list")
+
+(* List of syntaxes: *)
+let syntaxes = [ "camlp4o"; "camlp4r"; "camlp5o"; "camlp5r" ]
+
+let flag_all_except_link tag f =
+ flag ["ocaml"; "compile"; tag] f;
+ flag ["ocaml"; "ocamldep"; tag] f;
+ flag ["ocaml"; "doc"; tag] f
+
+let flag_all tag f =
+ flag_all_except_link tag f;
+ flag ["ocaml"; "link"; tag] f
+
+let _ =
+ dispatch begin function
+ | After_rules ->
+
+ let ocamlfind x = S[A"ocamlfind"; A x] in
+ Options.ocamlc := ocamlfind "ocamlc";
+ Options.ocamlopt := ocamlfind "ocamlopt";
+ Options.ocamldep := ocamlfind "ocamldep";
+ Options.ocamldoc := ocamlfind "ocamldoc";
+
+ flag ["ocaml"; "link"; "program"] & A"-linkpkg";
+
+ List.iter
+ (fun package -> flag_all ("pkg_" ^ package) (S[A"-package"; A package]))
+ (installed_packages ());
+
+ List.iter
+ (fun syntax -> flag_all_except_link ("syntax_" ^ syntax) (S[A"-syntax"; A syntax]))
+ syntaxes;
+
+ rule "install" ~prod:"install" ~deps:["META"; "rex.cma"; "rex.cmxa"; "rex.a"]
+ (fun _ _ -> Cmd (S[A"ocamlfind"; A"install"; A"rex"; A"META"; A"rex.cma"; A"rex.cmxa"; A"rex.mli"; A"rex.cmi"; A"rex.a"]));
+
+ rule "uninstall" ~prod:"uninstall" ~deps:[]
+ (fun _ _ -> Cmd (S[A"ocamlfind"; A"remove"; A"rex"]))
+ | _ -> ()
+ end
127 rex.ml
@@ -0,0 +1,127 @@
+
+open Rex_type
+
+type regexp = Rex_type.group
+
+type result = Rex_apply.R.t
+
+type 'a concurrent_list = (string * 'a) list
+
+type get = unit -> char Lwt.t
+
+exception EOS = Rex_type.EOS
+
+let regexp = Rex_parser.regexp
+
+let apply = Rex_apply.apply
+
+let group = Rex_apply.R.group
+
+let nth = Rex_apply.R.group_nth
+
+module ConcurrentApply = struct
+ module Entry = struct
+
+ type 'a t = {
+ rex : Rex_type.rex;
+ res : 'a;
+ }
+
+ let make s res = {
+ rex = Rex_parser.regexp s;
+ res = res;
+ }
+ end
+
+ type 'a t = {
+ length : int;
+ lst : 'a Entry.t list;
+ }
+
+ exception Found
+
+ type event =
+ | Char of char
+ | Exn of exn
+
+ let prepare lst = {
+ length = List.length lst;
+ lst = List.map (fun (s, f) -> Entry.make s f) lst;
+ }
+
+ let apply ~get lst =
+ let active = ref lst.length in
+ let waiting = ref 0 in
+ let found = ref None in
+
+ let conditions = List.map (fun _ -> Lwt_condition.create ()) lst.lst in
+ let notify v = List.iter (fun c -> Lwt_condition.signal c v) conditions in
+
+ let real_get () =
+ waiting := 0;
+ try_lwt
+ lwt c = get () in
+ notify (Char c);
+ Lwt.return c
+ with
+ | e ->
+ notify (Exn e);
+ Lwt.fail e
+ in
+
+ let get condition () =
+ if !found <> None then
+ begin
+ notify (Exn Found);
+ Lwt.fail Found
+ end
+ else
+ begin
+ incr waiting;
+ if !waiting = !active then
+ real_get ()
+ else
+ begin
+ lwt r = Lwt_condition.wait condition in
+ match r with
+ | Exn e -> Lwt.fail e
+ | Char r ->
+ Lwt.return r
+ end
+ end
+ in
+
+ let make_thread e condition =
+ try_lwt
+ lwt r = apply ~get:(get condition) e.Entry.rex in
+ lwt _ = match r with
+ | None ->
+ decr active;
+ if !active = !waiting then
+ lwt _ = real_get () in
+ Lwt.return ()
+ else
+ Lwt.return ()
+ | Some r ->
+ found := Some (e.Entry.res, r);
+ notify (Exn Found);
+ Lwt.return ()
+ in
+ Lwt.return ()
+ with
+ | Found ->
+ notify (Exn Found);
+ Lwt.return ()
+ in
+
+ let threads = List.map2 make_thread lst.lst conditions in
+
+ lwt _ = Lwt.join threads in
+ Lwt.return !found
+end
+
+type 'a concurrent = 'a ConcurrentApply.t
+
+let concurrent_prepare = ConcurrentApply.prepare
+
+let concurrent_apply = ConcurrentApply.apply
22 rex.mli
@@ -0,0 +1,22 @@
+
+type regexp
+
+type result
+
+type 'a concurrent
+
+type 'a concurrent_list = (string * 'a) list
+
+type get = unit -> char Lwt.t
+
+exception EOS
+
+val regexp: string -> regexp
+
+val apply: get : get -> regexp -> result option Lwt.t
+
+val concurrent_prepare: 'a concurrent_list -> 'a concurrent
+
+val concurrent_apply: get : get -> 'a concurrent -> ('a * result) option Lwt.t
+
+val nth: result -> int -> string
Oops, something went wrong.

0 comments on commit e63fcf2

Please sign in to comment.