unikernel/duniverse/ocaml-re/lib/emacs.ml

@@ -0,0 +1,145 @@
+(*
+   RE - A regular expression library
+
+   Copyright (C) 2001 Jerome Vouillon
+   email: Jerome.Vouillon@pps.jussieu.fr
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation, with
+   linking exception; either version 2.1 of the License, or (at
+   your option) any later version.
+
+   This library 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
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with this library; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+*)
+
+module Re = Core
+
+exception Parse_error
+exception Not_supported
+
+let by_code f c c' =
+  let c = Char.code c in
+  let c' = Char.code c' in
+  Char.chr (f c c')
+;;
+
+let parse ~emacs_only s =
+  let buf = Parse_buffer.create s in
+  let accept = Parse_buffer.accept buf in
+  let eos () = Parse_buffer.eos buf in
+  let test2 = Parse_buffer.test2 buf in
+  let get () = Parse_buffer.get buf in
+  let rec regexp () = regexp' [ branch () ]
+  and regexp' left =
+    if Parse_buffer.accept_s buf {|\||}
+    then regexp' (branch () :: left)
+    else Re.alt (List.rev left)
+  and branch () = branch' []
+  and branch' left =
+    if eos () || test2 '\\' '|' || test2 '\\' ')'
+    then Re.seq (List.rev left)
+    else branch' (piece () :: left)
+  and piece () =
+    let r = atom () in
+    if accept '*'
+    then Re.rep r
+    else if accept '+'
+    then Re.rep1 r
+    else if accept '?'
+    then Re.opt r
+    else r
+  and atom () =
+    if accept '.'
+    then Re.notnl
+    else if accept '^'
+    then Re.bol
+    else if accept '$'
+    then Re.eol
+    else if accept '['
+    then if accept '^' then Re.compl (bracket []) else Re.alt (bracket [])
+    else if accept '\\'
+    then
+      if accept '('
+      then (
+        let r = regexp () in
+        if not (Parse_buffer.accept_s buf {|\)|}) then raise Parse_error;
+        Re.group r)
+      else if emacs_only && accept '`'
+      then Re.bos
+      else if emacs_only && accept '\''
+      then Re.eos
+      else if accept '='
+      then Re.start
+      else if accept 'b'
+      then Re.alt [ Re.bow; Re.eow ]
+      else if emacs_only && accept 'B'
+      then Re.not_boundary
+      else if emacs_only && accept '<'
+      then Re.bow
+      else if emacs_only && accept '>'
+      then Re.eow
+      else if accept 'w'
+      then Re.alt [ Re.alnum; Re.char '_' ]
+      else if accept 'W'
+      then Re.compl [ Re.alnum; Re.char '_' ]
+      else (
+        if eos () then raise Parse_error;
+        match get () with
+        | ('*' | '+' | '?' | '[' | ']' | '.' | '^' | '$' | '\\') as c -> Re.char c
+        | '0' .. '9' -> raise Not_supported
+        | c -> if emacs_only then raise Parse_error else Re.char c)
+    else (
+      if eos () then raise Parse_error;
+      match get () with
+      | '*' | '+' | '?' -> raise Parse_error
+      | c -> Re.char c)
+  and bracket s =
+    if s <> [] && accept ']'
+    then s
+    else (
+      let c = char () in
+      if accept '-'
+      then
+        if accept ']'
+        then Re.char c :: Re.char '-' :: s
+        else (
+          let c' = char () in
+          let c' = by_code Int.max c c' in
+          bracket (Re.rg c c' :: s))
+      else bracket (Re.char c :: s))
+  and char () =
+    if eos () then raise Parse_error;
+    get ()
+  in
+  let res = regexp () in
+  if not (eos ()) then raise Parse_error;
+  res
+;;
+
+let re ?(case = true) s =
+  let r = parse s ~emacs_only:true in
+  if case then r else Re.no_case r
+;;
+
+let re_no_emacs ~case s =
+  let r = parse s ~emacs_only:false in
+  if case then r else Re.no_case r
+;;
+
+let re_result ?case s =
+  match re ?case s with
+  | s -> Ok s
+  | exception Not_supported -> Error `Not_supported
+  | exception Parse_error -> Error `Parse_error
+;;
+
+let compile = Re.compile
+let compile_pat ?(case = true) s = compile (re ~case s)