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

@@ -0,0 +1,444 @@
+open Import
+
+type ('a, _) ast =
+  | Alternative : 'a list -> ('a, [> `Uncased ]) ast
+  | No_case : 'a -> ('a, [> `Cased ]) ast
+  | Case : 'a -> ('a, [> `Cased ]) ast
+
+let dyn_of_ast f =
+  let open Dyn in
+  function
+  | Alternative xs -> variant "Alternative" (List.map xs ~f)
+  | No_case a -> variant "No_case" [ f a ]
+  | Case a -> variant "Case" [ f a ]
+;;
+
+let empty_alternative : ('a, 'b) ast = Alternative []
+
+let equal_ast (type a) eq (x : (a, [ `Uncased ]) ast) (y : (a, [ `Uncased ]) ast) =
+  match x, y with
+  | Alternative a, Alternative b -> List.equal ~eq a b
+;;
+
+let pp_ast (type a b) f fmt (ast : (a, b) ast) =
+  let open Fmt in
+  let var s re = sexp fmt s f re in
+  match ast with
+  | Alternative alt -> sexp fmt "Alternative" (list f) alt
+  | Case c -> var "Case" c
+  | No_case c -> var "No_case" c
+;;
+
+type cset =
+  | Cset of Cset.t
+  | Intersection of cset list
+  | Complement of cset list
+  | Difference of cset * cset
+  | Cast of (cset, [ `Cased | `Uncased ]) ast
+
+let rec dyn_of_cset =
+  let open Dyn in
+  function
+  | Cset cset -> variant "Cset" [ Cset.to_dyn cset ]
+  | Intersection xs -> variant "Intersection" (List.map xs ~f:dyn_of_cset)
+  | Complement xs -> variant "Complement" (List.map xs ~f:dyn_of_cset)
+  | Difference (x, y) -> variant "Difference" [ dyn_of_cset x; dyn_of_cset y ]
+  | Cast c -> variant "Cast" [ dyn_of_ast dyn_of_cset c ]
+;;
+
+type ('a, 'case) gen =
+  | Set of 'a
+  | Ast of (('a, 'case) gen, 'case) ast
+  | Sequence of ('a, 'case) gen list
+  | Repeat of ('a, 'case) gen * int * int option
+  | Beg_of_line
+  | End_of_line
+  | Beg_of_word
+  | End_of_word
+  | Not_bound
+  | Beg_of_str
+  | End_of_str
+  | Last_end_of_line
+  | Start
+  | Stop
+  | Group of string option * ('a, 'case) gen
+  | No_group of ('a, 'case) gen
+  | Nest of ('a, 'case) gen
+  | Pmark of Pmark.t * ('a, 'case) gen
+  | Sem of Automata.Sem.t * ('a, 'case) gen
+  | Sem_greedy of Automata.Rep_kind.t * ('a, 'case) gen
+
+let rec dyn_of_gen f =
+  let open Dyn in
+  function
+  | Set a -> variant "Set" [ f a ]
+  | Ast ast -> variant "Ast" [ dyn_of_ast (dyn_of_gen f) ast ]
+  | Sequence xs -> variant "Sequence" (List.map xs ~f:(dyn_of_gen f))
+  | Repeat (gen, min, max) ->
+    let base =
+      match max with
+      | None -> []
+      | Some x -> [ int x ]
+    in
+    variant "Repeat" (dyn_of_gen f gen :: int min :: base)
+  | Beg_of_line -> enum "Beg_of_line"
+  | End_of_line -> enum "End_of_line"
+  | Beg_of_word -> enum "Beg_of_word"
+  | End_of_word -> enum "End_of_word"
+  | Not_bound -> enum "Not_bound"
+  | Beg_of_str -> enum "Beg_of_str"
+  | End_of_str -> enum "End_of_str"
+  | Last_end_of_line -> enum "Last_end_of_line"
+  | Start -> enum "Start"
+  | Stop -> enum "Stop"
+  | Group (name, t) ->
+    let args =
+      let args = [ dyn_of_gen f t ] in
+      match name with
+      | None -> args
+      | Some name -> string name :: args
+    in
+    variant "Group" args
+  | No_group x -> variant "No_group" [ dyn_of_gen f x ]
+  | Nest x -> variant "Nest" [ dyn_of_gen f x ]
+  | Pmark (pmark, t) -> variant "Pmark" [ Pmark.to_dyn pmark; dyn_of_gen f t ]
+  | Sem (sem, t) -> variant "Sem" [ Automata.Sem.to_dyn sem; dyn_of_gen f t ]
+  | Sem_greedy (rep, t) ->
+    variant "Sem_greedy" [ Automata.Rep_kind.to_dyn rep; dyn_of_gen f t ]
+;;
+
+let rec pp_gen pp_cset fmt t =
+  let open Format in
+  let open Fmt in
+  let pp = pp_gen pp_cset in
+  let var s re = sexp fmt s pp re in
+  let seq s rel = sexp fmt s (list pp) rel in
+  match t with
+  | Set cset -> pp_cset fmt cset
+  | Sequence sq -> seq "Sequence" sq
+  | Repeat (re, start, stop) ->
+    let pp' fmt () = fprintf fmt "%a@ %d%a" pp re start optint stop in
+    sexp fmt "Repeat" pp' ()
+  | Beg_of_line -> str fmt "Beg_of_line"
+  | End_of_line -> str fmt "End_of_line"
+  | Beg_of_word -> str fmt "Beg_of_word"
+  | End_of_word -> str fmt "End_of_word"
+  | Not_bound -> str fmt "Not_bound"
+  | Beg_of_str -> str fmt "Beg_of_str"
+  | End_of_str -> str fmt "End_of_str"
+  | Last_end_of_line -> str fmt "Last_end_of_line"
+  | Start -> str fmt "Start"
+  | Stop -> str fmt "Stop"
+  | Group (None, c) -> var "Group" c
+  | Group (Some n, c) -> sexp fmt "Named_group" (pair str pp) (n, c)
+  | Nest c -> var "Nest" c
+  | Pmark (m, r) -> sexp fmt "Pmark" (pair Pmark.pp pp) (m, r)
+  | Ast a -> pp_ast pp fmt a
+  | Sem (sem, a) -> sexp fmt "Sem" (pair Automata.Sem.pp pp) (sem, a)
+  | Sem_greedy (k, re) -> sexp fmt "Sem_greedy" (pair Automata.Rep_kind.pp pp) (k, re)
+  | No_group c -> var "No_group" c
+;;
+
+let rec pp_cset fmt cset =
+  let open Fmt in
+  let seq s rel = sexp fmt s (list pp_cset) rel in
+  match cset with
+  | Cast s -> pp_ast pp_cset fmt s
+  | Cset s -> sexp fmt "Set" Cset.pp s
+  | Intersection c -> seq "Intersection" c
+  | Complement c -> seq "Complement" c
+  | Difference (a, b) -> sexp fmt "Difference" (pair pp_cset pp_cset) (a, b)
+;;
+
+let rec equal cset x1 x2 =
+  match x1, x2 with
+  | Set s1, Set s2 -> cset s1 s2
+  | Sequence l1, Sequence l2 -> List.equal ~eq:(equal cset) l1 l2
+  | Repeat (x1', i1, j1), Repeat (x2', i2, j2) ->
+    Int.equal i1 i2 && Option.equal Int.equal j1 j2 && equal cset x1' x2'
+  | Beg_of_line, Beg_of_line
+  | End_of_line, End_of_line
+  | Beg_of_word, Beg_of_word
+  | End_of_word, End_of_word
+  | Not_bound, Not_bound
+  | Beg_of_str, Beg_of_str
+  | End_of_str, End_of_str
+  | Last_end_of_line, Last_end_of_line
+  | Start, Start
+  | Stop, Stop -> true
+  | Group _, Group _ ->
+    (* Do not merge groups! *)
+    false
+  | Pmark (m1, r1), Pmark (m2, r2) -> Pmark.equal m1 m2 && equal cset r1 r2
+  | Nest x, Nest y -> equal cset x y
+  | Ast x, Ast y -> equal_ast (equal cset) x y
+  | Sem (sem, a), Sem (sem', a') -> Poly.equal sem sem' && equal cset a a'
+  | Sem_greedy (rep, a), Sem_greedy (rep', a') -> Poly.equal rep rep' && equal cset a a'
+  | _ -> false
+;;
+
+type t = (cset, [ `Cased | `Uncased ]) gen
+type no_case = (Cset.t, [ `Uncased ]) gen
+
+let to_dyn = dyn_of_gen dyn_of_cset
+let pp = pp_gen pp_cset
+let cset cset = Set (Cset cset)
+
+let rec handle_case_cset ign_case = function
+  | Cset s -> if ign_case then Cset.case_insens s else s
+  | Cast (Alternative l) -> List.map ~f:(handle_case_cset ign_case) l |> Cset.union_all
+  | Complement l ->
+    List.map ~f:(handle_case_cset ign_case) l |> Cset.union_all |> Cset.diff Cset.cany
+  | Difference (r, r') ->
+    Cset.inter
+      (handle_case_cset ign_case r)
+      (Cset.diff Cset.cany (handle_case_cset ign_case r'))
+  | Intersection l -> List.map ~f:(handle_case_cset ign_case) l |> Cset.intersect_all
+  | Cast (No_case a) -> handle_case_cset true a
+  | Cast (Case a) -> handle_case_cset false a
+;;
+
+let rec handle_case ign_case : t -> (Cset.t, [ `Uncased ]) gen = function
+  | Set s -> Set (handle_case_cset ign_case s)
+  | Sequence l -> Sequence (List.map ~f:(handle_case ign_case) l)
+  | Ast (Alternative l) ->
+    let l = List.map ~f:(handle_case ign_case) l in
+    Ast (Alternative l)
+  | Repeat (r, i, j) -> Repeat (handle_case ign_case r, i, j)
+  | ( Beg_of_line
+    | End_of_line
+    | Beg_of_word
+    | End_of_word
+    | Not_bound
+    | Beg_of_str
+    | End_of_str
+    | Last_end_of_line
+    | Start
+    | Stop ) as r -> r
+  | Sem (k, r) -> Sem (k, handle_case ign_case r)
+  | Sem_greedy (k, r) -> Sem_greedy (k, handle_case ign_case r)
+  | Group (n, r) -> Group (n, handle_case ign_case r)
+  | No_group r -> No_group (handle_case ign_case r)
+  | Nest r -> Nest (handle_case ign_case r)
+  | Ast (Case r) -> handle_case false r
+  | Ast (No_case r) -> handle_case true r
+  | Pmark (i, r) -> Pmark (i, handle_case ign_case r)
+;;
+
+module Export = struct
+  type nonrec t = t
+
+  let pp = pp
+
+  let seq = function
+    | [ r ] -> r
+    | l -> Sequence l
+  ;;
+
+  let char =
+    let f = Dense_map.make ~size:256 ~f:(fun i -> cset (Cset.csingle (Char.chr i))) in
+    fun c -> f (Char.code c)
+  ;;
+
+  let any = cset Cset.cany
+
+  let str s : t =
+    let l = ref [] in
+    for i = String.length s - 1 downto 0 do
+      l := char s.[i] :: !l
+    done;
+    seq !l
+  ;;
+
+  let as_set_elems elems =
+    match
+      List.map elems ~f:(function
+        | Set e -> e
+        | _ -> raise_notrace Exit)
+    with
+    | exception Exit -> None
+    | e -> Some e
+  ;;
+
+  let empty : t = Ast empty_alternative
+
+  let alt (elems : t list) : t =
+    match elems with
+    | [] -> empty
+    | [ x ] -> x
+    | _ ->
+      (match as_set_elems elems with
+       | None -> Ast (Alternative elems)
+       | Some elems -> Set (Cast (Alternative elems)))
+  ;;
+
+  let epsilon = seq []
+
+  let repn r i j =
+    if i < 0 then invalid_arg "Re.repn";
+    match j, i with
+    | Some j, _ when j < i -> invalid_arg "Re.repn"
+    | Some 0, 0 -> epsilon
+    | Some 1, 1 -> r
+    | _ -> Repeat (r, i, j)
+  ;;
+
+  let rep r = repn r 0 None
+  let rep1 r = repn r 1 None
+  let opt r = repn r 0 (Some 1)
+  let bol = Beg_of_line
+  let eol = End_of_line
+  let bow = Beg_of_word
+  let eow = End_of_word
+  let word r = seq [ bow; r; eow ]
+  let not_boundary = Not_bound
+  let bos = Beg_of_str
+  let eos = End_of_str
+  let whole_string r = seq [ bos; r; eos ]
+  let leol = Last_end_of_line
+  let start = Start
+  let stop = Stop
+
+  type 'b f = { f : 'a. 'a -> ('a, 'b) ast }
+
+  let make_set f t =
+    match t with
+    | Set x -> Set (Cast (f.f x))
+    | _ -> Ast (f.f t)
+  ;;
+
+  let preserve_set f t =
+    match t with
+    | Set _ -> t
+    | _ -> f t
+  ;;
+
+  let longest = preserve_set (fun t -> Sem (`Longest, t))
+  let shortest = preserve_set (fun t -> Sem (`Shortest, t))
+  let first = preserve_set (fun t -> Sem (`First, t))
+  let greedy = preserve_set (fun t -> Sem_greedy (`Greedy, t))
+  let non_greedy = preserve_set (fun t -> Sem_greedy (`Non_greedy, t))
+  let group ?name r = Group (name, r)
+  let no_group = preserve_set (fun t -> No_group t)
+  let nest r = Nest r
+  let set str = cset (Cset.set str)
+
+  let mark r =
+    let i = Pmark.gen () in
+    i, Pmark (i, r)
+  ;;
+
+  (**** Character sets ****)
+  let as_set_or_error name elems =
+    match as_set_elems elems with
+    | None -> invalid_arg name
+    | Some s -> s
+  ;;
+
+  let inter elems = Set (Intersection (as_set_or_error "Re.inter" elems))
+  let compl elems = Set (Complement (as_set_or_error "Re.compl" elems))
+
+  let diff r r' =
+    match r, r' with
+    | Set r, Set r' -> Set (Difference (r, r'))
+    | _, _ -> invalid_arg "Re.diff"
+  ;;
+
+  let case =
+    let f = { f = (fun r -> Case r) } in
+    fun t -> make_set f t
+  ;;
+
+  let no_case =
+    let f = { f = (fun r -> No_case r) } in
+    fun t -> make_set f t
+  ;;
+
+  let witness t =
+    let rec witness (t : no_case) =
+      match t with
+      | Set c -> String.make 1 (Cset.to_char (Cset.pick c))
+      | Sequence xs -> String.concat "" (List.map ~f:witness xs)
+      | Ast (Alternative (x :: _)) -> witness x
+      | Ast (Alternative []) -> assert false
+      | Repeat (r, from, _to) ->
+        let w = witness r in
+        let b = Buffer.create (String.length w * from) in
+        for _i = 1 to from do
+          Buffer.add_string b w
+        done;
+        Buffer.contents b
+      | No_group r -> witness r
+      | Sem_greedy (_, r) | Sem (_, r) | Nest r | Pmark (_, r) | Group (_, r) -> witness r
+      | Beg_of_line
+      | End_of_line
+      | Beg_of_word
+      | End_of_word
+      | Not_bound
+      | Beg_of_str
+      | Last_end_of_line
+      | Start
+      | Stop
+      | End_of_str -> ""
+    in
+    witness (handle_case false t)
+  ;;
+end
+
+open Export
+
+let rec merge_sequences = function
+  | [] -> []
+  | Ast (Alternative l') :: r -> merge_sequences (l' @ r)
+  | Sequence (x :: y) :: r ->
+    (match merge_sequences r with
+     | Sequence (x' :: y') :: r' when equal Cset.equal x x' ->
+       Sequence [ x; Ast (Alternative [ seq y; seq y' ]) ] :: r'
+     | r' -> Sequence (x :: y) :: r')
+  | x :: r -> x :: merge_sequences r
+;;
+
+(*XXX Use a better algorithm allowing non-contiguous regions? *)
+
+let colorize color_map (regexp : no_case) =
+  let lnl = ref false in
+  let rec colorize regexp =
+    match (regexp : no_case) with
+    | Set s -> Color_map.split color_map s
+    | Sequence l -> List.iter ~f:colorize l
+    | Ast (Alternative l) -> List.iter ~f:colorize l
+    | Repeat (r, _, _) -> colorize r
+    | Beg_of_line | End_of_line -> Color_map.split color_map Cset.nl
+    | Beg_of_word | End_of_word | Not_bound -> Color_map.split color_map Cset.cword
+    | Beg_of_str | End_of_str | Start | Stop -> ()
+    | Last_end_of_line -> lnl := true
+    | No_group r | Group (_, r) | Nest r | Pmark (_, r) -> colorize r
+    | Sem (_, r) | Sem_greedy (_, r) -> colorize r
+  in
+  colorize regexp;
+  !lnl
+;;
+
+let rec anchored_ast : (t, _) ast -> bool = function
+  | Alternative als -> List.for_all ~f:anchored als
+  | No_case r | Case r -> anchored r
+
+and anchored : t -> bool = function
+  | Ast a -> anchored_ast a
+  | Sequence l -> List.exists ~f:anchored l
+  | Repeat (r, i, _) -> i > 0 && anchored r
+  | No_group r | Sem (_, r) | Sem_greedy (_, r) | Group (_, r) | Nest r | Pmark (_, r) ->
+    anchored r
+  | Set _
+  | Beg_of_line
+  | End_of_line
+  | Beg_of_word
+  | End_of_word
+  | Not_bound
+  | End_of_str
+  | Last_end_of_line
+  | Stop -> false
+  | Beg_of_str | Start -> true
+;;
+
+let t_of_cset x = Set x

unikernel/duniverse/ocaml-re/lib/ast.mli

@@ -0,0 +1,91 @@
+type ('a, _) ast = private
+  | Alternative : 'a list -> ('a, [> `Uncased ]) ast
+  | No_case : 'a -> ('a, [> `Cased ]) ast
+  | Case : 'a -> ('a, [> `Cased ]) ast
+
+type cset = private
+  | Cset of Cset.t
+  | Intersection of cset list
+  | Complement of cset list
+  | Difference of cset * cset
+  | Cast of (cset, [ `Cased | `Uncased ]) ast
+
+type ('a, 'case) gen = private
+  | Set of 'a
+  | Ast of (('a, 'case) gen, 'case) ast
+  | Sequence of ('a, 'case) gen list
+  | Repeat of ('a, 'case) gen * int * int option
+  | Beg_of_line
+  | End_of_line
+  | Beg_of_word
+  | End_of_word
+  | Not_bound
+  | Beg_of_str
+  | End_of_str
+  | Last_end_of_line
+  | Start
+  | Stop
+  | Group of string option * ('a, 'case) gen
+  | No_group of ('a, 'case) gen
+  | Nest of ('a, 'case) gen
+  | Pmark of Pmark.t * ('a, 'case) gen
+  | Sem of Automata.Sem.t * ('a, 'case) gen
+  | Sem_greedy of Automata.Rep_kind.t * ('a, 'case) gen
+
+type t = (cset, [ `Cased | `Uncased ]) gen
+type no_case = (Cset.t, [ `Uncased ]) gen
+
+val to_dyn : t -> Dyn.t
+val pp : t Fmt.t
+val merge_sequences : (Cset.t, [ `Uncased ]) gen list -> (Cset.t, [ `Uncased ]) gen list
+val handle_case : bool -> t -> (Cset.t, [ `Uncased ]) gen
+val anchored : t -> bool
+val colorize : Color_map.t -> (Cset.t, [ `Uncased ]) gen -> bool
+
+module Export : sig
+  type nonrec t = t
+
+  val empty : t
+  val epsilon : t
+  val str : string -> t
+  val no_case : t -> t
+  val case : t -> t
+  val diff : t -> t -> t
+  val compl : t list -> t
+  val repn : t -> int -> int option -> t
+  val inter : t list -> t
+  val char : char -> t
+  val any : t
+  val set : string -> t
+  val mark : t -> Pmark.t * t
+  val nest : t -> t
+  val no_group : t -> t
+  val whole_string : t -> t
+  val leol : t
+  val longest : t -> t
+  val greedy : t -> t
+  val non_greedy : t -> t
+  val stop : t
+  val not_boundary : t
+  val group : ?name:string -> t -> t
+  val word : t -> t
+  val first : t -> t
+  val bos : t
+  val bow : t
+  val eow : t
+  val eos : t
+  val bol : t
+  val start : t
+  val eol : t
+  val opt : t -> t
+  val rep : t -> t
+  val rep1 : t -> t
+  val alt : t list -> t
+  val shortest : t -> t
+  val seq : t list -> t
+  val pp : t Fmt.t
+  val witness : t -> string
+end
+
+val cset : Cset.t -> t
+val t_of_cset : cset -> t

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

@@ -0,0 +1,781 @@
+open Import
+
+(*
+   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
+*)
+
+let hash_combine h accu = (accu * 65599) + h
+
+module Ids : sig
+  module Id : sig
+    type t
+
+    val equal : t -> t -> bool
+    val zero : t
+    val hash : t -> int
+    val pp : t Fmt.t
+
+    module Hash_set : sig
+      type id := t
+      type t
+
+      val create : unit -> t
+      val mem : t -> id -> bool
+      val add : t -> id -> unit
+      val clear : t -> unit
+    end
+  end
+
+  type t
+
+  val create : unit -> t
+  val next : t -> Id.t
+end = struct
+  module Id = struct
+    type t = int
+
+    module Hash_set = Hash_set
+
+    let equal = Int.equal
+    let zero = 0
+    let hash x = x
+    let pp = Fmt.int
+  end
+
+  type t = int ref
+
+  let create () = ref 0
+
+  let next t =
+    incr t;
+    !t
+  ;;
+end
+
+module Id = Ids.Id
+
+module Sem = struct
+  type t =
+    [ `Longest
+    | `Shortest
+    | `First
+    ]
+
+  let to_string = function
+    | `Shortest -> "short"
+    | `Longest -> "long"
+    | `First -> "first"
+  ;;
+
+  let to_dyn t = Dyn.enum (to_string t)
+  let equal = Poly.equal
+  let pp ch k = Format.pp_print_string ch (to_string k)
+end
+
+module Rep_kind = struct
+  type t =
+    [ `Greedy
+    | `Non_greedy
+    ]
+
+  let to_string = function
+    | `Greedy -> "Greedy"
+    | `Non_greedy -> "Non_greedy"
+  ;;
+
+  let to_dyn t = Dyn.enum (to_string t)
+  let pp fmt t = Format.pp_print_string fmt (to_string t)
+end
+
+module Mark : sig
+  type t = private int
+
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val pp : t Fmt.t
+  val to_dyn : t -> Dyn.t
+  val start : t
+  val prev : t -> t
+  val next : t -> t
+  val next2 : t -> t
+  val group_count : t -> int
+  val outside_range : t -> start_inclusive:t -> stop_inclusive:t -> bool
+end = struct
+  type t = int
+
+  let equal = Int.equal
+  let compare = Int.compare
+  let pp = Format.pp_print_int
+  let to_dyn = Dyn.int
+  let start = 0
+  let prev x = pred x
+  let next x = succ x
+  let next2 x = x + 2
+  let group_count x = x / 2
+
+  let outside_range t ~start_inclusive ~stop_inclusive =
+    t < start_inclusive || t > stop_inclusive
+  ;;
+end
+
+module Idx : sig
+  type t = private int
+
+  val pp : t Fmt.t
+  val to_dyn : t -> Dyn.t
+  val to_int : t -> int
+  val unknown : t
+  val initial : t
+  val used : t -> bool
+  val make : int -> t
+  val equal : t -> t -> bool
+end = struct
+  type t = int
+
+  let to_dyn = Dyn.int
+  let to_int x = x
+  let pp = Format.pp_print_int
+  let used t = t >= 0
+  let make x = x
+  let equal = Int.equal
+  let unknown = -1
+  let initial = 0
+end
+
+module Expr = struct
+  type t =
+    { id : Id.t
+    ; def : def
+    }
+
+  and def =
+    | Cst of Cset.t
+    | Alt of t list
+    | Seq of Sem.t * t * t
+    | Eps
+    | Rep of Rep_kind.t * Sem.t * t
+    | Mark of Mark.t
+    | Erase of Mark.t * Mark.t
+    | Before of Category.t
+    | After of Category.t
+    | Pmark of Pmark.t
+
+  let wrap_sem sem sem' v =
+    let open Dyn in
+    let name = Sem.to_string sem' in
+    match sem with
+    | Some sem when Sem.equal sem sem' -> v
+    | None | Some _ ->
+      (match v with
+       | List v -> variant name v
+       | _ -> variant name [ v ])
+  ;;
+
+  let rec seq_as_list sem = function
+    | Eps -> []
+    | Cst cs -> [ Cst cs ]
+    | Seq (sem', x, y) ->
+      if Sem.equal sem sem'
+      then x.def :: seq_as_list sem y.def
+      else raise_notrace Not_found
+    | _ -> raise_notrace Not_found
+  ;;
+
+  let seq_as_list sem t =
+    match seq_as_list sem t with
+    | exception Not_found -> None
+    | s -> Some s
+  ;;
+
+  let rec dyn_of_def sem =
+    let open Dyn in
+    function
+    | Cst cset -> Cset.to_dyn cset
+    | Alt alt -> variant "Alt" (List.map ~f:(to_dyn sem) alt)
+    | Seq (sem', x, y) ->
+      let to_dyn = to_dyn (Some sem') in
+      let x =
+        match seq_as_list sem' y.def with
+        | None -> variant "Seq" [ to_dyn x; to_dyn y ]
+        | Some y -> variant "Seq" (to_dyn x :: List.map y ~f:(dyn_of_def sem))
+      in
+      wrap_sem sem sem' x
+    | Eps -> Enum "Eps"
+    | Rep (_, sem', t) -> wrap_sem sem sem' (variant "Rep" [ to_dyn (Some sem') t ])
+    | Mark m -> variant "Mark" [ Mark.to_dyn m ]
+    | Pmark m -> variant "Pmark" [ Pmark.to_dyn m ]
+    | Erase (x, y) -> variant "Erase" [ Mark.to_dyn x; Mark.to_dyn y ]
+    | Before c -> variant "Before" [ Category.to_dyn c ]
+    | After c -> variant "After" [ Category.to_dyn c ]
+
+  and to_dyn sem { id = _; def } = dyn_of_def sem def
+
+  let rec pp_with_sem sem ch e =
+    let open Fmt in
+    match e.def with
+    | Cst l -> sexp ch "cst" Cset.pp l
+    | Alt l -> sexp ch "alt" (list (pp_with_sem sem)) l
+    | Seq (k, e, e') ->
+      sexp ch "seq" (triple Sem.pp (pp_with_sem sem) (pp_with_sem sem)) (k, e, e')
+    | Eps -> str ch "eps"
+    | Rep (_rk, k, e) -> sexp ch "rep" (pair Sem.pp (pp_with_sem (Some k))) (k, e)
+    | Mark i -> sexp ch "mark" Mark.pp i
+    | Pmark i -> sexp ch "pmark" Pmark.pp i
+    | Erase (b, e) -> sexp ch "erase" (pair Mark.pp Mark.pp) (b, e)
+    | Before c -> sexp ch "before" Category.pp c
+    | After c -> sexp ch "after" Category.pp c
+  ;;
+
+  let pp = pp_with_sem None
+  let eps_expr = { id = Id.zero; def = Eps }
+  let mk ids def = { id = Ids.next ids; def }
+  let empty ids = mk ids (Alt [])
+  let cst ids s = if Cset.is_empty s then empty ids else mk ids (Cst s)
+  let eps ids = mk ids Eps
+  let rep ids kind sem x = mk ids (Rep (kind, sem, x))
+  let mark ids m = mk ids (Mark m)
+  let pmark ids i = mk ids (Pmark i)
+  let erase ids m m' = mk ids (Erase (m, m'))
+  let before ids c = mk ids (Before c)
+  let after ids c = mk ids (After c)
+
+  let alt ids = function
+    | [] -> empty ids
+    | [ c ] -> c
+    | l -> mk ids (Alt l)
+  ;;
+
+  let seq ids (kind : Sem.t) x y =
+    match x.def, y.def with
+    | Alt [], _ -> x
+    | _, Alt [] -> y
+    | Eps, _ -> y
+    | _, Eps when Sem.equal kind `First -> x
+    | _ -> mk ids (Seq (kind, x, y))
+  ;;
+
+  let is_eps expr =
+    match expr.def with
+    | Eps -> true
+    | _ -> false
+  ;;
+
+  let rec rename ids x =
+    match x.def with
+    | Cst _ | Eps | Mark _ | Pmark _ | Erase _ | Before _ | After _ -> mk ids x.def
+    | Alt l -> mk ids (Alt (List.map ~f:(rename ids) l))
+    | Seq (k, y, z) -> mk ids (Seq (k, rename ids y, rename ids z))
+    | Rep (g, k, y) -> mk ids (Rep (g, k, rename ids y))
+  ;;
+end
+
+type expr = Expr.t
+
+include Expr
+
+module Marks = struct
+  type t =
+    { marks : (Mark.t * Idx.t) list
+    ; pmarks : Pmark.Set.t
+    }
+
+  let to_dyn { marks; pmarks } : Dyn.t =
+    let open Dyn in
+    record
+      [ ( "marks"
+        , List.map marks ~f:(fun (m, idx) -> pair (Mark.to_dyn m) (Idx.to_dyn idx))
+          |> list )
+      ; "pmarks", Pmark.Set.to_list pmarks |> List.map ~f:Pmark.to_dyn |> list
+      ]
+  ;;
+
+  let equal { marks; pmarks } t =
+    List.equal
+      ~eq:(fun (x, y) (x', y') -> Mark.equal x x' && Idx.equal y y')
+      marks
+      t.marks
+    && Pmark.Set.equal pmarks t.pmarks
+  ;;
+
+  let empty = { marks = []; pmarks = Pmark.Set.empty }
+
+  let hash_marks_offset =
+    let f acc ((a : Mark.t), (i : Idx.t)) =
+      hash_combine (a :> int) (hash_combine (i :> int) acc)
+    in
+    fun l init -> List.fold_left l ~init ~f
+  ;;
+
+  let hash m accu = hash_marks_offset m.marks (hash_combine (Hashtbl.hash m.pmarks) accu)
+
+  let marks_set_idx =
+    let rec marks_set_idx idx marks =
+      match marks with
+      | [] -> []
+      | (a, idx') :: rem ->
+        if Idx.equal idx' Idx.unknown then (a, idx) :: marks_set_idx idx rem else marks
+    in
+    fun marks idx -> { marks with marks = marks_set_idx idx marks.marks }
+  ;;
+
+  let filter t (b : Mark.t) (e : Mark.t) =
+    { t with
+      marks =
+        List.filter t.marks ~f:(fun ((i : Mark.t), _) ->
+          Mark.outside_range i ~start_inclusive:b ~stop_inclusive:e)
+    }
+  ;;
+
+  let set_mark t (i : Mark.t) =
+    { t with marks = (i, Idx.unknown) :: List.remove_assq i t.marks }
+  ;;
+
+  let set_pmark t i = { t with pmarks = Pmark.Set.add i t.pmarks }
+
+  let pp fmt { marks; pmarks } =
+    Format.pp_open_box fmt 1;
+    (match marks with
+     | [] -> ()
+     | _ :: _ ->
+       Format.fprintf
+         fmt
+         "@[<2>marks@ %a@]"
+         (Format.pp_print_list (fun fmt (a, i) ->
+            Format.fprintf fmt "%a-%a" Mark.pp a Idx.pp i))
+         marks);
+    (match Pmark.Set.to_list pmarks with
+     | [] -> ()
+     | pmarks ->
+       Format.fprintf fmt "@[<2>pmarks %a@]" (Format.pp_print_list Pmark.pp) pmarks);
+    Format.pp_close_box fmt ()
+  ;;
+end
+
+module Status = struct
+  type t =
+    | Failed
+    | Match of Mark_infos.t * Pmark.Set.t
+    | Running
+end
+
+module Desc : sig
+  type t
+
+  val pp : t Fmt.t
+
+  module E : sig
+    type nonrec t = private
+      | TSeq of Sem.t * t * Expr.t
+      | TExp of Marks.t * Expr.t
+      | TMatch of Marks.t
+  end
+
+  val to_dyn : t -> Dyn.t
+  val fold_right : t -> init:'acc -> f:(E.t -> 'acc -> 'acc) -> 'acc
+  val tseq : Sem.t -> t -> Expr.t -> t -> t
+  val initial : Expr.t -> t
+  val empty : t
+  val set_idx : Idx.t -> t -> t
+  val hash : t -> int -> int
+  val equal : t -> t -> bool
+  val status : t -> Status.t
+  val first_match : t -> Marks.t option
+  val remove_matches : t -> t
+  val split_at_match : t -> t * t
+  val add_match : t -> Marks.t -> t
+  val add_eps : t -> Marks.t -> t
+  val add_expr : t -> E.t -> t
+  val iter_marks : t -> f:(Marks.t -> unit) -> unit
+  val remove_duplicates : Id.Hash_set.t -> t -> Expr.t -> t
+end = struct
+  module E = struct
+    type t =
+      | TSeq of Sem.t * t list * Expr.t
+      | TExp of Marks.t * Expr.t
+      | TMatch of Marks.t
+
+    let rec equal_list l1 l2 = List.equal ~eq:equal l1 l2
+
+    and equal x y =
+      match x, y with
+      | TSeq (_, l1, e1), TSeq (_, l2, e2) -> Id.equal e1.id e2.id && equal_list l1 l2
+      | TExp (marks1, e1), TExp (marks2, e2) ->
+        Id.equal e1.id e2.id && Marks.equal marks1 marks2
+      | TMatch marks1, TMatch marks2 -> Marks.equal marks1 marks2
+      | _, _ -> false
+    ;;
+
+    let rec hash (t : t) accu =
+      match t with
+      | TSeq (_, l, e) ->
+        hash_combine 0x172a1bce (hash_combine (Id.hash e.id) (hash_list l accu))
+      | TExp (marks, e) ->
+        hash_combine 0x2b4c0d77 (hash_combine (Id.hash e.id) (Marks.hash marks accu))
+      | TMatch marks -> hash_combine 0x1c205ad5 (Marks.hash marks accu)
+
+    and hash_list =
+      let f acc x = hash x acc in
+      fun l init -> List.fold_left l ~init ~f
+    ;;
+  end
+
+  type t = E.t list
+
+  let rec to_dyn sem t = Dyn.list (List.map ~f:(dyn_of_e sem) t)
+
+  and dyn_of_e sem =
+    let open Dyn in
+    function
+    | E.TSeq (sem', x, y) ->
+      wrap_sem
+        sem
+        sem'
+        (variant "TSeq" [ to_dyn (Some sem') x; Expr.to_dyn (Some sem') y ])
+    | TExp (marks, e) ->
+      let e =
+        let base = [ Expr.to_dyn sem e ] in
+        if Marks.(equal empty marks) then base else Marks.to_dyn marks :: base
+      in
+      variant "TExp" e
+    | TMatch m -> variant "TMarks" [ Marks.to_dyn m ]
+  ;;
+
+  let to_dyn t = to_dyn None t
+
+  open E
+
+  let equal = E.equal_list
+  let hash = E.hash_list
+
+  let tseq' kind x y =
+    match x with
+    | [] -> []
+    | [ TExp (marks, { def = Eps; _ }) ] -> [ TExp (marks, y) ]
+    | _ -> [ TSeq (kind, x, y) ]
+  ;;
+
+  let tseq kind x y rem = tseq' kind x y @ rem
+
+  let rec fold_right t ~init ~f =
+    match t with
+    | [] -> init
+    | x :: xs -> f x (fold_right xs ~init ~f)
+  ;;
+
+  let rec iter_marks t ~f =
+    List.iter t ~f:(fun (e : E.t) ->
+      match e with
+      | TSeq (_, l, _) -> iter_marks l ~f
+      | TExp (marks, _) | TMatch marks -> f marks)
+  ;;
+
+  let rec print_state_rec ch e (y : Expr.t) =
+    match e with
+    | TMatch marks -> Format.fprintf ch "@[<2>(TMatch@ %a)@]" Marks.pp marks
+    | TSeq (sem, l', x) ->
+      Format.fprintf ch "@[<2>(TSeq@ %a@ " Sem.pp sem;
+      print_state_lst ch l' x;
+      Format.fprintf ch "@ %a)@]" Expr.pp x
+    | TExp (marks, { def = Eps; _ }) ->
+      Format.fprintf ch "@[<2>(TExp@ %a@ (%a)@ (eps))@]" Id.pp y.id Marks.pp marks
+    | TExp (marks, x) ->
+      Format.fprintf ch "@[<2>(TExp@ %a@ (%a)@ %a)@]" Id.pp x.id Marks.pp marks Expr.pp x
+
+  and print_state_lst ch l y =
+    match l with
+    | [] -> Format.fprintf ch "()"
+    | e :: rem ->
+      print_state_rec ch e y;
+      List.iter rem ~f:(fun e ->
+        Format.fprintf ch "@ | ";
+        print_state_rec ch e y)
+  ;;
+
+  let pp ch t = print_state_lst ch [ t ] { id = Id.zero; def = Eps }
+
+  let rec first_match = function
+    | [] -> None
+    | TMatch marks :: _ -> Some marks
+    | _ :: r -> first_match r
+  ;;
+
+  let remove_matches t =
+    List.filter t ~f:(function
+      | TMatch _ -> false
+      | _ -> true)
+  ;;
+
+  let split_at_match =
+    let rec split_at_match_rec l = function
+      | [] -> assert false
+      | TMatch _ :: r -> List.rev l, remove_matches r
+      | x :: r -> split_at_match_rec (x :: l) r
+    in
+    fun l -> split_at_match_rec [] l
+  ;;
+
+  let status : _ -> Status.t = function
+    | [] -> Failed
+    | TMatch m :: _ -> Match (Mark_infos.make (m.marks :> (int * int) list), m.pmarks)
+    | _ -> Running
+  ;;
+
+  let set_idx =
+    let rec f idx = function
+      | TMatch marks -> TMatch (Marks.marks_set_idx marks idx)
+      | TSeq (kind, l, x) -> TSeq (kind, set_idx idx l, x)
+      | TExp (marks, x) -> TExp (Marks.marks_set_idx marks idx, x)
+    and set_idx idx xs = List.map xs ~f:(f idx) in
+    set_idx
+  ;;
+
+  let[@ocaml.warning "-32"] pp fmt t =
+    Format.fprintf fmt "[%a]" (Format.pp_print_list ~pp_sep:(Fmt.lit "; ") pp) t
+  ;;
+
+  let empty = []
+  let initial expr = [ TExp (Marks.empty, expr) ]
+  let add_match t marks = TMatch marks :: t
+  let add_eps t marks = TExp (marks, eps_expr) :: t
+  let add_expr t expr = expr :: t
+
+  let remove_duplicates =
+    let rec loop seen l y =
+      match l with
+      | [] -> []
+      | (TMatch _ as x) :: _ ->
+        (* Truncate after first match *)
+        [ x ]
+      | TSeq (kind, l, x) :: r ->
+        let l = loop seen l x in
+        let r = loop seen r y in
+        tseq kind l x r
+      | (TExp (_marks, { def = Eps; _ }) as e) :: r ->
+        if Id.Hash_set.mem seen y.id
+        then loop seen r y
+        else (
+          Id.Hash_set.add seen y.id;
+          e :: loop seen r y)
+      | (TExp (_marks, x) as e) :: r ->
+        if Id.Hash_set.mem seen x.id
+        then loop seen r y
+        else (
+          Id.Hash_set.add seen x.id;
+          e :: loop seen r y)
+    in
+    fun seen l y ->
+      Id.Hash_set.clear seen;
+      loop seen l y
+  ;;
+end
+
+module E = Desc.E
+
+module State = struct
+  type t =
+    { idx : Idx.t
+    ; category : Category.t
+    ; desc : Desc.t
+    ; mutable status : Status.t option
+    ; hash : int
+    }
+  (* Thread-safety: We use double-checked locking to access field
+     [status] in function [status] below. *)
+
+  let pp fmt t = Desc.pp fmt t.desc
+  let[@inline] idx t = t.idx
+  let to_dyn t = Desc.to_dyn t.desc
+
+  let dummy =
+    { idx = Idx.unknown
+    ; category = Category.dummy
+    ; desc = Desc.empty
+    ; status = None
+    ; hash = -1
+    }
+  ;;
+
+  let hash idx cat desc =
+    Desc.hash desc (hash_combine idx (hash_combine (Category.to_int cat) 0))
+    land 0x3FFFFFFF
+  ;;
+
+  let mk idx cat desc =
+    { idx; category = cat; desc; status = None; hash = hash (idx :> int) cat desc }
+  ;;
+
+  let create cat e = mk Idx.initial cat (Desc.initial e)
+
+  let equal { idx; category; desc; status = _; hash } t =
+    Int.equal hash t.hash
+    && Idx.equal idx t.idx
+    && Category.equal category t.category
+    && Desc.equal desc t.desc
+  ;;
+
+  (* To be called when the mutex has already been acquired *)
+  let status_no_mutex s =
+    match s.status with
+    | Some s -> s
+    | None ->
+      let st = Desc.status s.desc in
+      s.status <- Some st;
+      st
+  ;;
+
+  let status m s =
+    match s.status with
+    | Some s -> s
+    | None ->
+      Mutex.lock m;
+      let st = status_no_mutex s in
+      Mutex.unlock m;
+      st
+  ;;
+
+  module Table = Hashtbl.Make (struct
+      type nonrec t = t
+
+      let equal = equal
+      let hash t = t.hash
+    end)
+end
+
+(**** Find a free index ****)
+
+module Working_area = struct
+  type t =
+    { mutable ids : Bit_vector.t
+    ; seen : Id.Hash_set.t
+    ; index_count : int Atomic.t
+    }
+
+  let create () =
+    { ids = Bit_vector.create_zero 1
+    ; seen = Id.Hash_set.create ()
+    ; index_count = Atomic.make 0
+    }
+  ;;
+
+  let index_count w = Atomic.get w.index_count
+
+  let mark_used_indices tbl =
+    Desc.iter_marks ~f:(fun marks ->
+      List.iter marks.marks ~f:(fun (_, i) ->
+        if Idx.used i then Bit_vector.set tbl (i :> int) true))
+  ;;
+
+  let rec find_free tbl idx len =
+    if idx = len || not (Bit_vector.get tbl idx) then idx else find_free tbl (idx + 1) len
+  ;;
+
+  let free_index t l =
+    Bit_vector.reset_zero t.ids;
+    mark_used_indices t.ids l;
+    let len = Bit_vector.length t.ids in
+    let idx = find_free t.ids 0 len in
+    if idx = len
+    then (
+      t.ids <- Bit_vector.create_zero (2 * len);
+      (* This function is only called when the mutex is locked. So we
+         are sure that this is always coherent with the length of
+         [t.ids]. *)
+      Atomic.set t.index_count (2 * len));
+    Idx.make idx
+  ;;
+end
+
+(**** Computation of the next state ****)
+
+type ctx =
+  { c : Cset.c
+  ; prev_cat : Category.t
+  ; next_cat : Category.t
+  }
+
+let rec delta_expr ({ c; _ } as ctx) marks (x : Expr.t) rem =
+  (*Format.eprintf "%d@." x.id;*)
+  match x.def with
+  | Cst s -> if Cset.mem c s then Desc.add_eps rem marks else rem
+  | Alt l -> delta_alt ctx marks l rem
+  | Seq (kind, y, z) ->
+    let y = delta_expr ctx marks y Desc.empty in
+    delta_seq ctx kind y z rem
+  | Rep (rep_kind, kind, y) -> delta_rep ctx marks x rep_kind kind y rem
+  | Eps -> Desc.add_match rem marks
+  | Mark i -> Desc.add_match rem (Marks.set_mark marks i)
+  | Pmark i -> Desc.add_match rem (Marks.set_pmark marks i)
+  | Erase (b, e) -> Desc.add_match rem (Marks.filter marks b e)
+  | Before cat ->
+    if Category.intersect ctx.next_cat cat then Desc.add_match rem marks else rem
+  | After cat ->
+    if Category.intersect ctx.prev_cat cat then Desc.add_match rem marks else rem
+
+and delta_rep ctx marks x rep_kind kind y rem =
+  let y, marks' =
+    let y = delta_expr ctx marks y Desc.empty in
+    match Desc.first_match y with
+    | None -> y, marks
+    | Some marks -> Desc.remove_matches y, marks
+  in
+  match rep_kind with
+  | `Greedy -> Desc.tseq kind y x (Desc.add_match rem marks')
+  | `Non_greedy -> Desc.add_match (Desc.tseq kind y x rem) marks
+
+and delta_alt ctx marks l rem = List.fold_right l ~init:rem ~f:(delta_expr ctx marks)
+
+and delta_seq ctx (kind : Sem.t) y z rem =
+  match Desc.first_match y with
+  | None -> Desc.tseq kind y z rem
+  | Some marks ->
+    (match kind with
+     | `Longest -> Desc.tseq kind (Desc.remove_matches y) z (delta_expr ctx marks z rem)
+     | `Shortest -> delta_expr ctx marks z (Desc.tseq kind (Desc.remove_matches y) z rem)
+     | `First ->
+       let y, y' = Desc.split_at_match y in
+       Desc.tseq kind y z (delta_expr ctx marks z (Desc.tseq kind y' z rem)))
+;;
+
+let rec delta_e ctx marks (x : E.t) rem =
+  match x with
+  | TSeq (kind, y, z) ->
+    let y = delta_desc ctx marks y Desc.empty in
+    delta_seq ctx kind y z rem
+  | TExp (marks, e) -> delta_expr ctx marks e rem
+  | TMatch _ -> Desc.add_expr rem x
+
+and delta_desc ctx marks (l : Desc.t) rem =
+  Desc.fold_right l ~init:rem ~f:(fun y acc -> delta_e ctx marks y acc)
+;;
+
+let delta (tbl_ref : Working_area.t) next_cat char (st : State.t) =
+  let expr =
+    let prev_cat = st.category in
+    let ctx = { c = char; next_cat; prev_cat } in
+    Desc.remove_duplicates
+      tbl_ref.seen
+      (delta_desc ctx Marks.empty st.desc Desc.empty)
+      Expr.eps_expr
+  in
+  let idx = Working_area.free_index tbl_ref expr in
+  let expr = Desc.set_idx idx expr in
+  State.mk idx next_cat expr
+;;

unikernel/duniverse/ocaml-re/lib/automata.mli

@@ -0,0 +1,123 @@
+(*
+   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
+*)
+
+(* Regular expressions *)
+
+module Mark : sig
+  type t [@@immediate]
+
+  val compare : t -> t -> int
+  val start : t
+  val prev : t -> t
+  val next : t -> t
+  val next2 : t -> t
+  val group_count : t -> int
+end
+
+module Sem : sig
+  type t =
+    [ `Longest
+    | `Shortest
+    | `First
+    ]
+
+  val to_dyn : t -> Dyn.t
+  val pp : t Fmt.t
+end
+
+module Rep_kind : sig
+  type t =
+    [ `Greedy
+    | `Non_greedy
+    ]
+
+  val to_dyn : t -> Dyn.t
+  val pp : t Fmt.t
+end
+
+type expr
+
+val is_eps : expr -> bool
+val pp : expr Fmt.t
+
+module Ids : sig
+  type t
+
+  val create : unit -> t
+end
+
+val cst : Ids.t -> Cset.t -> expr
+val empty : Ids.t -> expr
+val alt : Ids.t -> expr list -> expr
+val seq : Ids.t -> Sem.t -> expr -> expr -> expr
+val eps : Ids.t -> expr
+val rep : Ids.t -> Rep_kind.t -> Sem.t -> expr -> expr
+val mark : Ids.t -> Mark.t -> expr
+val pmark : Ids.t -> Pmark.t -> expr
+val erase : Ids.t -> Mark.t -> Mark.t -> expr
+val before : Ids.t -> Category.t -> expr
+val after : Ids.t -> Category.t -> expr
+val rename : Ids.t -> expr -> expr
+
+(****)
+
+(* States of the automata *)
+
+module Idx : sig
+  type t
+
+  val to_int : t -> int
+end
+
+module Status : sig
+  type t =
+    | Failed
+    | Match of Mark_infos.t * Pmark.Set.t
+    | Running
+end
+
+module State : sig
+  type t
+
+  val pp : t Fmt.t
+  val dummy : t
+  val create : Category.t -> expr -> t
+  val idx : t -> Idx.t
+  val status_no_mutex : t -> Status.t
+  val status : Mutex.t -> t -> Status.t
+  val to_dyn : t -> Dyn.t
+
+  module Table : Hashtbl.S with type key = t
+end
+
+(****)
+
+(* Computation of the states following a given state *)
+
+module Working_area : sig
+  type t
+
+  val create : unit -> t
+  val index_count : t -> int
+end
+
+val delta : Working_area.t -> Category.t -> Cset.c -> State.t -> State.t

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

@@ -0,0 +1,48 @@
+type t =
+  { len : int
+  ; bits : Bytes.t
+  }
+
+let byte s i = Char.code (Bytes.unsafe_get s i)
+let set_byte s i x = Bytes.unsafe_set s i (Char.chr x)
+let length t = t.len
+
+let unsafe_set v n b =
+  let i = n lsr 3 in
+  let c = byte v.bits i in
+  let mask = 1 lsl (n land 7) in
+  set_byte v.bits i (if b then c lor mask else c land lnot mask)
+;;
+
+let set v n b =
+  if n < 0 || n >= v.len then invalid_arg "Bit_vector.set";
+  unsafe_set v n b
+;;
+
+let unsafe_get v n =
+  let i = n lsr 3 in
+  byte v.bits i land (1 lsl (n land 7)) > 0
+;;
+
+let get v n =
+  if n < 0 || n >= v.len then invalid_arg "Bit_vector.get";
+  unsafe_get v n
+;;
+
+let reset_zero t = Bytes.fill t.bits 0 (Bytes.length t.bits) '\000'
+
+let create_zero len =
+  let bits =
+    let r = len land 7 in
+    let q = len lsr 3 in
+    let len = if r = 0 then q else q + 1 in
+    Bytes.make len '\000'
+  in
+  { len; bits }
+;;
+
+let pp fmt { len; bits } =
+  let len fmt () = Fmt.sexp fmt "len" Fmt.int len in
+  let bits fmt () = Fmt.sexp fmt "bits" Fmt.bytes bits in
+  Format.fprintf fmt "%a@.%a@." len () bits ()
+;;

unikernel/duniverse/ocaml-re/lib/bit_vector.mli

@@ -0,0 +1,8 @@
+type t
+
+val length : t -> int
+val set : t -> int -> bool -> unit
+val create_zero : int -> t
+val get : t -> int -> bool
+val reset_zero : t -> unit
+val pp : t Fmt.t

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

@@ -0,0 +1,29 @@
+type t = int
+
+let equal (x : int) (y : int) = x = y
+let compare (x : int) (y : int) = compare x y
+let to_int x = x
+let pp = Format.pp_print_int
+let intersect x y = x land y <> 0
+let ( ++ ) x y = x lor y
+let dummy = -1
+let inexistant = 1
+let letter = 2
+let not_letter = 4
+let newline = 8
+let lastnewline = 16
+let search_boundary = 32
+let to_dyn = Dyn.int
+
+let from_char = function
+  (* Should match [cword] definition *)
+  | 'a' .. 'z'
+  | 'A' .. 'Z'
+  | '0' .. '9'
+  | '_' | '\170' | '\181' | '\186'
+  | '\192' .. '\214'
+  | '\216' .. '\246'
+  | '\248' .. '\255' -> letter
+  | '\n' -> not_letter ++ newline
+  | _ -> not_letter
+;;

unikernel/duniverse/ocaml-re/lib/category.mli

@@ -0,0 +1,22 @@
+(** Categories represent the various kinds of characters that can be tested
+    by look-ahead and look-behind operations.
+
+    This is more restricted than Cset, but faster. *)
+
+type t [@@immediate]
+
+val ( ++ ) : t -> t -> t
+val from_char : char -> t
+val dummy : t
+val inexistant : t
+val letter : t
+val not_letter : t
+val newline : t
+val lastnewline : t
+val search_boundary : t
+val to_int : t -> int
+val equal : t -> t -> bool
+val compare : t -> t -> int
+val intersect : t -> t -> bool
+val pp : t Fmt.t
+val to_dyn : t -> Dyn.t

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

@@ -0,0 +1,56 @@
+(* In reality, this can really be represented as a bool array.
+
+   The representation is best thought of as a list of all chars along with a
+   flag:
+
+   (a, 0), (b, 1), (c, 0), (d, 0), ...
+
+   characters belonging to the same color are represented by sequnces of
+   characters with the flag set to 0.
+*)
+
+type t = Bytes.t
+
+module Repr = struct
+  type t = string
+
+  let repr t color = t.[Cset.to_int color]
+  let length = String.length
+end
+
+module Table = struct
+  type t = string
+
+  let get_char t c = t.[Cset.to_int c]
+  let get t c = Cset.of_char (String.unsafe_get t (Char.code c))
+
+  let translate_colors (cm : t) cset =
+    Cset.fold_right cset ~init:Cset.empty ~f:(fun i j l ->
+      let start = get_char cm i in
+      let stop = get_char cm j in
+      Cset.union (Cset.cseq start stop) l)
+  ;;
+end
+
+let make () = Bytes.make 257 '\000'
+
+let flatten cm =
+  let c = Bytes.create 256 in
+  let color_repr = Bytes.create 256 in
+  let v = ref 0 in
+  Bytes.set c 0 '\000';
+  Bytes.set color_repr 0 '\000';
+  for i = 1 to 255 do
+    if Bytes.get cm i <> '\000' then incr v;
+    Bytes.set c i (Char.chr !v);
+    Bytes.set color_repr !v (Char.chr i)
+  done;
+  Bytes.unsafe_to_string c, Bytes.sub_string color_repr 0 (!v + 1)
+;;
+
+(* mark all the endpoints of the intervals of the char set with the 1 byte *)
+let split t set =
+  Cset.iter set ~f:(fun i j ->
+    Bytes.set t (Cset.to_int i) '\001';
+    Bytes.set t (Cset.to_int j + 1) '\001')
+;;

unikernel/duniverse/ocaml-re/lib/color_map.mli

@@ -0,0 +1,27 @@
+(* Color maps exists to provide an optimization for the regex engine. The fact
+   that some characters are entirely equivalent for some regexes means that we
+   can use them interchangeably.
+
+   A color map assigns a color to every character in our character set. Any two
+   characters with the same color will be treated equivalently by the automaton.
+*)
+type t
+
+module Repr : sig
+  type t
+
+  val repr : t -> Cset.c -> char
+  val length : t -> int
+end
+
+module Table : sig
+  type t
+
+  val get_char : t -> Cset.c -> char
+  val get : t -> char -> Cset.c
+  val translate_colors : t -> Cset.t -> Cset.t
+end
+
+val make : unit -> t
+val flatten : t -> Table.t * Repr.t
+val split : t -> Cset.t -> unit

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

@@ -0,0 +1,835 @@
+open Import
+
+let rec iter n f v = if Int.equal n 0 then v else iter (n - 1) f (f v)
+
+module Idx : sig
+  type t [@@immediate]
+
+  val unknown : t
+  val make_break : Automata.Idx.t -> t
+  val of_idx : Automata.Idx.t -> t
+  val is_idx : t -> bool
+  val is_break : t -> bool
+  val is_unknown : t -> bool
+  val idx : t -> int
+  val break_idx : t -> int
+end = struct
+  type t = int
+
+  let unknown = -2
+  let break = -3
+  let of_idx (x : Automata.Idx.t) = Automata.Idx.to_int x [@@inline always]
+  let is_idx t = t >= 0 [@@inline always]
+  let is_break x = x <= break [@@inline always]
+  let is_unknown x = x = unknown [@@inline always]
+  let idx t = t [@@inline always]
+  let make_break (idx : Automata.Idx.t) = -5 - Automata.Idx.to_int idx [@@inline always]
+  let break_idx t = (t + 5) * -1 [@@inline always]
+end
+
+type match_info =
+  | Match of Group.t
+  | Failed
+  | Running of { no_match_starts_before : int }
+
+type state_info =
+  { idx : Idx.t
+  ; (* Index of the current position in the position table.
+       Not yet computed transitions point to a dummy state where
+       [idx] is set to [unknown];
+       If [idx] is set to [break] for states that either always
+       succeed or always fail. *)
+    mutable final : (Category.t * (Automata.Idx.t * Automata.Status.t)) list
+  ; (* Mapping from the category of the next character to
+       - the index where the next position should be saved
+       - possibly, the list of marks (and the corresponding indices)
+         corresponding to the best match *)
+    desc : Automata.State.t (* Description of this state of the automata *)
+  }
+
+(* Thread-safety: we use double-checked locking to access field [final]. *)
+
+(* A state [t] is a pair composed of some information about the
+   state [state_info] and a transition table [t array], indexed by
+   color. For performance reason, to avoid an indirection, we manually
+   unbox the transition table: we allocate a single array, with the
+   state information at index 0, followed by the transitions. *)
+module State : sig
+  type t
+
+  val make : ncol:int -> state_info -> t
+  val make_break : state_info -> t
+  val get_info : t -> state_info
+  val follow_transition : t -> color:Cset.c -> t
+  val set_transition : t -> color:Cset.c -> t -> unit
+  val is_unknown_transition : t -> color:Cset.c -> bool
+end = struct
+  type t = Table of t array [@@unboxed]
+
+  (* Thread-safety:
+     We store the state information at index 0. For other elements
+     of the transition table, which are lazily computed, we use
+     double-checked locking. *)
+
+  let get_info (Table st) : state_info = Obj.magic (Array.unsafe_get st 0)
+  [@@inline always]
+  ;;
+
+  let set_info (Table st) (info : state_info) = st.(0) <- Obj.magic info
+
+  let follow_transition (Table st) ~color = Array.unsafe_get st (1 + Cset.to_int color)
+  [@@inline always]
+  ;;
+
+  let set_transition (Table st) ~color st' = st.(1 + Cset.to_int color) <- st'
+
+  let is_unknown_transition st ~color =
+    let st' = follow_transition st ~color in
+    let info = get_info st' in
+    Idx.is_unknown info.idx
+  ;;
+
+  let dummy (info : state_info) = Table [| Obj.magic info |]
+  let unknown_state = dummy { idx = Idx.unknown; final = []; desc = Automata.State.dummy }
+
+  let make ~ncol state =
+    let st = Table (Array.make (ncol + 1) unknown_state) in
+    set_info st state;
+    st
+  ;;
+
+  let make_break state = Table [| Obj.magic state |]
+end
+
+(* Automata (compiled regular expression) *)
+type re =
+  { initial : Automata.expr
+  ; (* The whole regular expression *)
+    mutable initial_states : (Category.t * State.t) list
+  ; (* Initial states, indexed by initial category *)
+    colors : Color_map.Table.t
+  ; (* Color table *)
+    color_repr : Color_map.Repr.t
+  ; (* Table from colors to one character of this color *)
+    ncolor : int
+  ; (* Number of colors. *)
+    lnl : Cset.c
+  ; (* Color of the last newline. [Cset.null_char] if unnecessary *)
+    tbl : Automata.Working_area.t
+  ; (* Temporary table used to compute the first available index
+       when computing a new state *)
+    states : State.t Automata.State.Table.t
+  ; (* States of the deterministic automata *)
+    group_names : (string * int) list
+  ; (* Named groups in the regular expression *)
+    group_count : int
+  ; (* Number of groups in the regular expression *)
+    mutex : Mutex.t
+  }
+
+(* Thread-safety:
+   We use double-checked locking to access field [initial_states]. The
+   state table [states] and the working area [tbl] are only accessed
+   with the mutex [mutex] locked.
+   The working area is shared between all threads. This might be
+   inefficient if many threads are updating the automaton. It seems
+   complicated to manage a working area per domain and per regular
+   expression. So, if this becomes an issue, it might just be simpler
+   to allocate a fresh working area whenever needed.
+*)
+
+let pp_re ch re = Automata.pp ch re.initial
+let group_count re = re.group_count
+let group_names re = re.group_names
+
+module Positions = struct
+  (* Information used during matching *)
+  type t =
+    { mutable positions : int array
+    ; (* Array of mark positions
+         The mark are off by one for performance reasons *)
+      mutable length : int
+    }
+
+  let empty = { positions = [||]; length = 0 }
+  let length t = t.length
+  let unsafe_set t idx pos = Array.unsafe_set t.positions idx pos
+
+  let rec resize idx t =
+    t.length <- 2 * t.length;
+    if idx >= t.length
+    then resize idx t
+    else (
+      let pos = t.positions in
+      t.positions <- Array.make t.length 0;
+      Array.blit pos 0 t.positions 0 (Array.length pos))
+  ;;
+
+  let set t idx pos =
+    if idx >= length t then resize idx t;
+    unsafe_set t idx pos
+  ;;
+
+  let all t = t.positions
+  let first t = t.positions.(0)
+
+  let make ~groups re =
+    if groups
+    then (
+      (* We initialize this table with a reasonable size. The required
+         size may change when the automaton gets updated. So we are
+         always checking whether it is large enough before modifying it. *)
+      let length = Automata.Working_area.index_count re.tbl + 1 in
+      { positions = Array.make length 0; length })
+    else empty
+  ;;
+end
+
+(****)
+
+let category re ~color =
+  if Cset.equal_c color Cset.null_char
+  then Category.inexistant (* Special category for the last newline *)
+  else if Cset.equal_c color re.lnl
+  then Category.(lastnewline ++ newline ++ not_letter)
+  else Category.from_char (Color_map.Repr.repr re.color_repr color)
+;;
+
+(****)
+
+let find_state re desc =
+  try Automata.State.Table.find re.states desc with
+  | Not_found ->
+    let st =
+      let break_state =
+        match Automata.State.status_no_mutex desc with
+        | Running -> false
+        | Failed | Match _ -> true
+      in
+      let st =
+        { idx =
+            (let idx = Automata.State.idx desc in
+             if break_state then Idx.make_break idx else Idx.of_idx idx)
+        ; final = []
+        ; desc
+        }
+      in
+      if break_state then State.make_break st else State.make ~ncol:re.ncolor st
+    in
+    Automata.State.Table.add re.states desc st;
+    st
+;;
+
+(**** Match with marks ****)
+
+let delta re cat ~color st = Automata.delta re.tbl cat color st.desc
+
+let validate re (s : string) ~pos st =
+  let color = Color_map.Table.get re.colors s.[pos] in
+  Mutex.lock re.mutex;
+  if State.is_unknown_transition st ~color
+  then (
+    let st' =
+      let desc' =
+        let cat = category re ~color in
+        delta re cat ~color (State.get_info st)
+      in
+      find_state re desc'
+    in
+    State.set_transition st ~color st');
+  Mutex.unlock re.mutex
+;;
+
+let next colors st s pos =
+  State.follow_transition st ~color:(Color_map.Table.get colors (String.unsafe_get s pos))
+;;
+
+let rec loop re ~colors ~positions s ~pos ~last st0 st =
+  if pos < last
+  then (
+    let st' = next colors st s pos in
+    let idx = (State.get_info st').idx in
+    if Idx.is_idx idx
+    then
+      if Idx.idx idx < Positions.length positions
+      then (
+        Positions.unsafe_set positions (Idx.idx idx) pos;
+        loop re ~colors ~positions s ~pos:(pos + 1) ~last st' st')
+      else (
+        (* Resize position array *)
+        Positions.set positions (Idx.idx idx) pos;
+        loop re ~colors ~positions s ~pos:(pos + 1) ~last st' st')
+    else if Idx.is_break idx
+    then (
+      Positions.set positions (Idx.break_idx idx) pos;
+      st')
+    else (
+      (* Unknown *)
+      validate re s ~pos st0;
+      loop re ~colors ~positions s ~pos ~last st0 st0))
+  else st
+;;
+
+let rec loop_no_mark re ~colors s ~pos ~last st0 st =
+  if pos < last
+  then (
+    let st' = next colors st s pos in
+    let idx = (State.get_info st').idx in
+    if Idx.is_idx idx
+    then loop_no_mark re ~colors s ~pos:(pos + 1) ~last st' st'
+    else if Idx.is_break idx
+    then st'
+    else (
+      (* Unknown *)
+      validate re s ~pos st0;
+      loop_no_mark re ~colors s ~pos ~last st0 st0))
+  else st
+;;
+
+let final re st cat =
+  try List.assq cat st.final with
+  | Not_found ->
+    Mutex.lock re.mutex;
+    let res =
+      try List.assq cat st.final with
+      | Not_found ->
+        let st' = delta re cat ~color:Cset.null_char st in
+        let res = Automata.State.idx st', Automata.State.status_no_mutex st' in
+        st.final <- (cat, res) :: st.final;
+        res
+    in
+    Mutex.unlock re.mutex;
+    res
+;;
+
+let find_initial_state re cat =
+  try List.assq cat re.initial_states with
+  | Not_found ->
+    Mutex.lock re.mutex;
+    let res =
+      try List.assq cat re.initial_states with
+      | Not_found ->
+        let st = find_state re (Automata.State.create cat re.initial) in
+        re.initial_states <- (cat, st) :: re.initial_states;
+        st
+    in
+    Mutex.unlock re.mutex;
+    res
+;;
+
+let get_color re (s : string) pos =
+  if pos < 0
+  then Cset.null_char
+  else (
+    let slen = String.length s in
+    if pos >= slen
+    then Cset.null_char
+    else if pos = slen - 1
+            && (not (Cset.equal_c re.lnl Cset.null_char))
+            && Char.equal (String.unsafe_get s pos) '\n'
+    then (* Special case for the last newline *)
+      re.lnl
+    else Color_map.Table.get re.colors (String.unsafe_get s pos))
+;;
+
+let rec handle_last_newline re positions ~pos st ~groups =
+  let st' = State.follow_transition st ~color:re.lnl in
+  let info = State.get_info st' in
+  if Idx.is_idx info.idx
+  then (
+    if groups then Positions.set positions (Idx.idx info.idx) pos;
+    st')
+  else if Idx.is_break info.idx
+  then (
+    if groups then Positions.set positions (Idx.break_idx info.idx) pos;
+    st')
+  else (
+    (* Unknown *)
+    let color = re.lnl in
+    Mutex.lock re.mutex;
+    if State.is_unknown_transition st ~color
+    then (
+      let st' =
+        let desc =
+          let cat = category re ~color in
+          let real_c = Color_map.Table.get re.colors '\n' in
+          delta re cat ~color:real_c (State.get_info st)
+        in
+        find_state re desc
+      in
+      State.set_transition st ~color st');
+    Mutex.unlock re.mutex;
+    handle_last_newline re positions ~pos st ~groups)
+;;
+
+let rec scan_str re positions (s : string) initial_state ~last ~pos ~groups =
+  if last = String.length s
+     && (not (Cset.equal_c re.lnl Cset.null_char))
+     && last > pos
+     && Char.equal (String.get s (last - 1)) '\n'
+  then (
+    let last = last - 1 in
+    let st = scan_str re positions ~pos s initial_state ~last ~groups in
+    if Idx.is_break (State.get_info st).idx
+    then st
+    else handle_last_newline re positions ~pos:last st ~groups)
+  else if groups
+  then loop re ~colors:re.colors ~positions s ~pos ~last initial_state initial_state
+  else loop_no_mark re ~colors:re.colors s ~pos ~last initial_state initial_state
+;;
+
+(* This function adds a final boundary check on the input.
+   This is useful to indicate that the output failed because
+   of insufficient input, or to verify that the output actually
+   matches for regex that have boundary conditions with respect
+   to the input string.
+*)
+let final_boundary_check re positions ~last ~slen s state_info ~groups =
+  let idx, res =
+    let final_cat =
+      Category.(
+        search_boundary
+        ++ if last = slen then inexistant else category re ~color:(get_color re s last))
+    in
+    final re state_info final_cat
+  in
+  (match groups, res with
+   | true, Match _ -> Positions.set positions (Automata.Idx.to_int idx) last
+   | _ -> ());
+  res
+;;
+
+let make_match_str re positions ~len ~groups ~partial s ~pos =
+  let slen = String.length s in
+  let last = if len = -1 then slen else pos + len in
+  let st =
+    let initial_state =
+      let initial_cat =
+        Category.(
+          search_boundary
+          ++ if pos = 0 then inexistant else category re ~color:(get_color re s (pos - 1)))
+      in
+      find_initial_state re initial_cat
+    in
+    scan_str re positions s initial_state ~pos ~last ~groups
+  in
+  let state_info = State.get_info st in
+  if Idx.is_break state_info.idx || (partial && not groups)
+  then Automata.State.status re.mutex state_info.desc
+  else if partial && groups
+  then (
+    match Automata.State.status re.mutex state_info.desc with
+    | (Match _ | Failed) as status -> status
+    | Running ->
+      (* This could be because it's still not fully matched, or it
+         could be that because we need to run special end of input
+         checks. *)
+      (match final_boundary_check re positions ~last ~slen s state_info ~groups with
+       | Match _ as status -> status
+       | Failed | Running ->
+         (* A failure here just means that we need more data, i.e.
+            it's a partial match. *)
+         Running))
+  else final_boundary_check re positions ~last ~slen s state_info ~groups
+;;
+
+module Stream = struct
+  type nonrec t =
+    { state : State.t
+    ; re : re
+    }
+
+  type 'a feed =
+    | Ok of 'a
+    | No_match
+
+  let create re =
+    let category = Category.(search_boundary ++ inexistant) in
+    let state = find_initial_state re category in
+    { state; re }
+  ;;
+
+  let feed t s ~pos ~len =
+    (* TODO bound checks? *)
+    let last = pos + len in
+    let state = loop_no_mark t.re ~colors:t.re.colors s ~last ~pos t.state t.state in
+    let info = State.get_info state in
+    if Idx.is_break info.idx
+       &&
+       match Automata.State.status t.re.mutex info.desc with
+       | Failed -> true
+       | Match _ | Running -> false
+    then No_match
+    else Ok { t with state }
+  ;;
+
+  let finalize t s ~pos ~len =
+    (* TODO bound checks? *)
+    let last = pos + len in
+    let state = scan_str t.re Positions.empty s t.state ~last ~pos ~groups:false in
+    let info = State.get_info state in
+    match
+      let _idx, res =
+        let final_cat = Category.(search_boundary ++ inexistant) in
+        final t.re info final_cat
+      in
+      res
+    with
+    | Running | Failed -> false
+    | Match _ -> true
+  ;;
+
+  module Group = struct
+    type nonrec t =
+      { t : t
+      ; positions : Positions.t
+      ; slices : Slice.L.t
+      ; abs_pos : int
+      ; first_match_pos : int
+      }
+
+    let no_match_starts_before t = t.first_match_pos
+
+    let create t =
+      { t
+      ; positions = Positions.make ~groups:true t.re
+      ; slices = []
+      ; abs_pos = 0
+      ; first_match_pos = 0
+      }
+    ;;
+
+    module Match = struct
+      type t =
+        { pmarks : Pmark.Set.t
+        ; slices : Slice.L.t
+        ; marks : Mark_infos.t
+        ; positions : int array
+        ; start_pos : int
+        }
+
+      let test_mark t mark = Pmark.Set.mem mark t.pmarks
+
+      let get t i =
+        Mark_infos.offset t.marks i
+        |> Option.map (fun (start, stop) ->
+          let start = t.positions.(start) - t.start_pos in
+          let stop = t.positions.(stop) - t.start_pos in
+          Slice.L.get_substring t.slices ~start ~stop)
+      ;;
+
+      let make ~start_pos ~pmarks ~slices ~marks ~positions =
+        let positions = Positions.all positions in
+        { pmarks; slices; positions; marks; start_pos }
+      ;;
+    end
+
+    let rec loop re ~abs_pos ~colors ~positions s ~pos ~last st0 st =
+      if pos < last
+      then (
+        let st' = next colors st s pos in
+        let idx = (State.get_info st').idx in
+        if Idx.is_idx idx
+        then
+          if Idx.idx idx < Positions.length positions
+          then (
+            Positions.unsafe_set positions (Idx.idx idx) (abs_pos + pos);
+            loop re ~abs_pos ~colors ~positions s ~pos:(pos + 1) ~last st' st')
+          else (
+            (* Resize position array *)
+            Positions.set positions (Idx.idx idx) (abs_pos + pos);
+            loop re ~abs_pos ~colors ~positions s ~pos:(pos + 1) ~last st' st')
+        else if Idx.is_break idx
+        then (
+          Positions.set positions (Idx.break_idx idx) (abs_pos + pos);
+          st')
+        else (
+          (* Unknown *)
+          validate re s ~pos st0;
+          loop re ~abs_pos ~colors ~positions s ~pos ~last st0 st0))
+      else st
+    ;;
+
+    let feed ({ t; positions; slices; abs_pos; first_match_pos = _ } as tt) s ~pos ~len =
+      let state =
+        (* TODO bound checks? *)
+        let last = pos + len in
+        loop t.re ~abs_pos ~colors:t.re.colors s ~positions ~last ~pos t.state t.state
+      in
+      let info = State.get_info state in
+      if Idx.is_break info.idx
+         &&
+         match Automata.State.status t.re.mutex info.desc with
+         | Failed -> true
+         | Match _ | Running -> false
+      then No_match
+      else (
+        let t = { t with state } in
+        let slices = { Slice.s; pos; len } :: slices in
+        let first_match_pos = Positions.first positions in
+        let slices = Slice.L.drop_rev slices (first_match_pos - tt.first_match_pos) in
+        let abs_pos = abs_pos + len in
+        Ok { tt with t; slices; abs_pos; first_match_pos })
+    ;;
+
+    let finalize
+      ({ t; positions; slices; abs_pos; first_match_pos = _ } as tt)
+      s
+      ~pos
+      ~len
+      : Match.t feed
+      =
+      (* TODO bound checks? *)
+      let last = pos + len in
+      let info =
+        let state =
+          loop t.re ~abs_pos ~colors:t.re.colors s ~positions ~last ~pos t.state t.state
+        in
+        State.get_info state
+      in
+      match
+        match Automata.State.status t.re.mutex info.desc with
+        | (Match _ | Failed) as s -> s
+        | Running ->
+          let idx, res =
+            let final_cat = Category.(search_boundary ++ inexistant) in
+            final t.re info final_cat
+          in
+          (match res with
+           | Running | Failed -> ()
+           | Match _ -> Positions.set positions (Automata.Idx.to_int idx) (abs_pos + last));
+          res
+      with
+      | Running | Failed -> No_match
+      | Match (marks, pmarks) ->
+        let first_match_position = Positions.first positions in
+        let slices =
+          let slices =
+            let slices = { Slice.s; pos; len } :: slices in
+            Slice.L.drop_rev slices (first_match_position - tt.first_match_pos)
+          in
+          List.rev slices
+        in
+        Ok (Match.make ~start_pos:first_match_position ~pmarks ~marks ~slices ~positions)
+    ;;
+  end
+end
+
+let match_str_no_bounds ~groups ~partial re s ~pos ~len =
+  let positions = Positions.make ~groups re in
+  match make_match_str re positions ~len ~groups ~partial s ~pos with
+  | Match (marks, pmarks) ->
+    Match
+      (Group.create s marks pmarks ~gpos:(Positions.all positions) ~gcount:re.group_count)
+  | Failed -> Failed
+  | Running ->
+    let no_match_starts_before = if groups then Positions.first positions else 0 in
+    Running { no_match_starts_before }
+;;
+
+let match_str_p re s ~pos ~len =
+  if pos < 0 || len < -1 || pos + len > String.length s
+  then invalid_arg "Re.exec: out of bounds";
+  match make_match_str re Positions.empty ~len ~groups:false ~partial:false s ~pos with
+  | Match _ -> true
+  | _ -> false
+;;
+
+let match_str ~groups ~partial re s ~pos ~len =
+  if pos < 0 || len < -1 || pos + len > String.length s
+  then invalid_arg "Re.exec: out of bounds";
+  match_str_no_bounds ~groups ~partial re s ~pos ~len
+;;
+
+let mk_re ~initial ~colors ~color_repr ~ncolor ~lnl ~group_names ~group_count =
+  { initial
+  ; initial_states = []
+  ; colors
+  ; color_repr
+  ; ncolor
+  ; lnl
+  ; tbl = Automata.Working_area.create ()
+  ; states = Automata.State.Table.create 97
+  ; group_names
+  ; group_count
+  ; mutex = Mutex.create ()
+  }
+;;
+
+(**** Compilation ****)
+
+module A = Automata
+
+let enforce_kind ids kind kind' cr =
+  match kind, kind' with
+  | `First, `First -> cr
+  | `First, k -> A.seq ids k cr (A.eps ids)
+  | _ -> cr
+;;
+
+type context =
+  { ids : A.Ids.t
+  ; kind : A.Sem.t
+  ; ign_group : bool
+  ; greedy : A.Rep_kind.t
+  ; pos : A.Mark.t ref
+  ; names : (string * int) list ref
+  ; cache : Cset.t Cset.CSetMap.t ref
+  ; colors : Color_map.Table.t
+  }
+
+let trans_set cache (cm : Color_map.Table.t) s =
+  match Cset.one_char s with
+  | Some i -> Cset.csingle (Color_map.Table.get_char cm i)
+  | None ->
+    let v = Cset.hash s, s in
+    (try Cset.CSetMap.find v !cache with
+     | Not_found ->
+       let l = Color_map.Table.translate_colors cm s in
+       cache := Cset.CSetMap.add v l !cache;
+       l)
+;;
+
+let make_repeater ids cr kind greedy =
+  match greedy with
+  | `Greedy -> fun rem -> A.alt ids [ A.seq ids kind (A.rename ids cr) rem; A.eps ids ]
+  | `Non_greedy ->
+    fun rem -> A.alt ids [ A.eps ids; A.seq ids kind (A.rename ids cr) rem ]
+;;
+
+(* XXX should probably compute a category mask *)
+let rec translate
+  ({ ids; kind; ign_group; greedy; pos; names; cache; colors } as ctx)
+  (ast : Ast.no_case)
+  =
+  match ast with
+  | Set s -> A.cst ids (trans_set cache colors s), kind
+  | Sequence l -> trans_seq ctx l, kind
+  | Ast (Alternative l) ->
+    (match Ast.merge_sequences l with
+     | [ r' ] ->
+       let cr, kind' = translate ctx r' in
+       enforce_kind ids kind kind' cr, kind
+     | merged_sequences ->
+       ( A.alt
+           ids
+           (List.map merged_sequences ~f:(fun r' ->
+              let cr, kind' = translate ctx r' in
+              enforce_kind ids kind kind' cr))
+       , kind ))
+  | Repeat (r', i, j) ->
+    let cr, kind' = translate ctx r' in
+    let rem =
+      match j with
+      | None -> A.rep ids greedy kind' cr
+      | Some j ->
+        let f = make_repeater ids cr kind' greedy in
+        iter (j - i) f (A.eps ids)
+    in
+    iter i (fun rem -> A.seq ids kind' (A.rename ids cr) rem) rem, kind
+  | Beg_of_line -> A.after ids Category.(inexistant ++ newline), kind
+  | End_of_line -> A.before ids Category.(inexistant ++ newline), kind
+  | Beg_of_word ->
+    ( A.seq
+        ids
+        `First
+        (A.after ids Category.(inexistant ++ not_letter))
+        (A.before ids Category.letter)
+    , kind )
+  | End_of_word ->
+    ( A.seq
+        ids
+        `First
+        (A.after ids Category.letter)
+        (A.before ids Category.(inexistant ++ not_letter))
+    , kind )
+  | Not_bound ->
+    ( A.alt
+        ids
+        [ A.seq ids `First (A.after ids Category.letter) (A.before ids Category.letter)
+        ; (let cat = Category.(inexistant ++ not_letter) in
+           A.seq ids `First (A.after ids cat) (A.before ids cat))
+        ]
+    , kind )
+  | Beg_of_str -> A.after ids Category.inexistant, kind
+  | End_of_str -> A.before ids Category.inexistant, kind
+  | Last_end_of_line -> A.before ids Category.(inexistant ++ lastnewline), kind
+  | Start -> A.after ids Category.search_boundary, kind
+  | Stop -> A.before ids Category.search_boundary, kind
+  | Sem (kind', r') ->
+    let cr, kind'' = translate { ctx with kind = kind' } r' in
+    enforce_kind ids kind' kind'' cr, kind'
+  | Sem_greedy (greedy', r') -> translate { ctx with greedy = greedy' } r'
+  | Group (n, r') ->
+    if ign_group
+    then translate ctx r'
+    else (
+      let p = !pos in
+      let () =
+        match n with
+        | Some name -> names := (name, A.Mark.group_count p) :: !names
+        | None -> ()
+      in
+      pos := A.Mark.next2 !pos;
+      let cr, kind' = translate ctx r' in
+      ( A.seq ids `First (A.mark ids p) (A.seq ids `First cr (A.mark ids (A.Mark.next p)))
+      , kind' ))
+  | No_group r' -> translate { ctx with ign_group = true } r'
+  | Nest r' ->
+    let b = !pos in
+    let cr, kind' = translate ctx r' in
+    let e = A.Mark.prev !pos in
+    if A.Mark.compare e b = -1
+    then cr, kind'
+    else A.seq ids `First (A.erase ids b e) cr, kind'
+  | Pmark (i, r') ->
+    let cr, kind' = translate ctx r' in
+    A.seq ids `First (A.pmark ids i) cr, kind'
+
+and trans_seq ({ ids; kind; _ } as ctx) = function
+  | [] -> A.eps ids
+  | [ r ] ->
+    let cr', kind' = translate ctx r in
+    enforce_kind ids kind kind' cr'
+  | r :: rem ->
+    let cr', kind' = translate ctx r in
+    let cr'' = trans_seq ctx rem in
+    if A.is_eps cr'' then cr' else if A.is_eps cr' then cr'' else A.seq ids kind' cr' cr''
+;;
+
+let compile_1 regexp =
+  let regexp = Ast.handle_case false regexp in
+  let color_map = Color_map.make () in
+  let need_lnl = Ast.colorize color_map regexp in
+  let colors, color_repr = Color_map.flatten color_map in
+  let ncolor = Color_map.Repr.length color_repr in
+  let lnl = if need_lnl then Cset.of_int ncolor else Cset.null_char in
+  let ncolor = if need_lnl then ncolor + 1 else ncolor in
+  let ctx =
+    { ids = A.Ids.create ()
+    ; kind = `First
+    ; ign_group = false
+    ; greedy = `Greedy
+    ; pos = ref A.Mark.start
+    ; names = ref []
+    ; cache = ref Cset.CSetMap.empty
+    ; colors
+    }
+  in
+  let r, kind = translate ctx regexp in
+  let r = enforce_kind ctx.ids `First kind r in
+  (*Format.eprintf "<%d %d>@." !ids ncol;*)
+  mk_re
+    ~initial:r
+    ~colors
+    ~color_repr
+    ~ncolor
+    ~lnl
+    ~group_names:(List.rev !(ctx.names))
+    ~group_count:(A.Mark.group_count !(ctx.pos))
+;;
+
+let compile r =
+  let open Ast.Export in
+  compile_1 (if Ast.anchored r then group r else seq [ shortest (rep any); group r ])
+;;

unikernel/duniverse/ocaml-re/lib/compile.mli

@@ -0,0 +1,59 @@
+type re
+
+module Stream : sig
+  type t
+
+  type 'a feed =
+    | Ok of 'a
+    | No_match
+
+  val create : re -> t
+  val feed : t -> string -> pos:int -> len:int -> t feed
+  val finalize : t -> string -> pos:int -> len:int -> bool
+
+  module Group : sig
+    type stream := t
+    type t
+
+    module Match : sig
+      type t
+
+      val get : t -> int -> string option
+      val test_mark : t -> Pmark.t -> bool
+    end
+
+    val create : stream -> t
+    val feed : t -> string -> pos:int -> len:int -> t feed
+    val finalize : t -> string -> pos:int -> len:int -> Match.t feed
+    val no_match_starts_before : t -> int
+  end
+end
+
+type match_info =
+  | Match of Group.t
+  | Failed
+  | Running of { no_match_starts_before : int }
+
+val match_str_no_bounds
+  :  groups:bool
+  -> partial:bool
+  -> re
+  -> string
+  -> pos:int
+  -> len:int
+  -> match_info
+
+val match_str
+  :  groups:bool
+  -> partial:bool
+  -> re
+  -> string
+  -> pos:int
+  -> len:int
+  -> match_info
+
+val match_str_p : re -> string -> pos:int -> len:int -> bool
+val compile : Ast.t -> re
+val group_count : re -> int
+val group_names : re -> (string * int) list
+val pp_re : re Fmt.t

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

@@ -0,0 +1,173 @@
+(*
+   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
+*)
+
+open Import
+
+include struct
+  let cset = Ast.cset
+  let rg c c' = cset (Cset.cseq c c')
+  let notnl = cset Cset.notnl
+  let lower = cset Cset.lower
+  let upper = cset Cset.upper
+  let alpha = cset Cset.alpha
+  let digit = cset Cset.cdigit
+  let alnum = cset Cset.alnum
+  let wordc = cset Cset.wordc
+  let ascii = cset Cset.ascii
+  let blank = cset Cset.blank
+  let cntrl = cset Cset.cntrl
+  let graph = cset Cset.graph
+  let print = cset Cset.print
+  let punct = cset Cset.punct
+  let space = cset Cset.space
+  let xdigit = cset Cset.xdigit
+end
+
+include Ast.Export
+
+let exec_internal ?(pos = 0) ?(len = -1) ~partial ~groups re s =
+  Compile.match_str ~groups ~partial re s ~pos ~len
+;;
+
+let exec ?pos ?len re s =
+  match exec_internal ?pos ?len ~groups:true ~partial:false re s with
+  | Match substr -> substr
+  | _ -> raise Not_found
+;;
+
+let exec_opt ?pos ?len re s =
+  match exec_internal ?pos ?len ~groups:true ~partial:false re s with
+  | Match substr -> Some substr
+  | _ -> None
+;;
+
+let execp ?(pos = 0) ?(len = -1) re s = Compile.match_str_p ~pos ~len re s
+
+let exec_partial ?pos ?len re s =
+  match exec_internal ~groups:false ~partial:true ?pos ?len re s with
+  | Match _ -> `Full
+  | Running _ -> `Partial
+  | Failed -> `Mismatch
+;;
+
+let exec_partial_detailed ?pos ?len re s =
+  match exec_internal ~groups:true ~partial:true ?pos ?len re s with
+  | Match group -> `Full group
+  | Running { no_match_starts_before } -> `Partial no_match_starts_before
+  | Failed -> `Mismatch
+;;
+
+module Mark = struct
+  type t = Pmark.t
+
+  let test (g : Group.t) p = Pmark.Set.mem p (Group.pmarks g)
+  let all (g : Group.t) = Group.pmarks g
+
+  module Set = Pmark.Set
+
+  let equal = Pmark.equal
+  let compare = Pmark.compare
+end
+
+type split_token =
+  [ `Text of string
+  | `Delim of Group.t
+  ]
+
+module Gen = struct
+  type 'a gen = unit -> 'a option
+
+  let gen_of_seq (s : 'a Seq.t) : 'a gen =
+    let r = ref s in
+    fun () ->
+      match !r () with
+      | Seq.Nil -> None
+      | Seq.Cons (x, tl) ->
+        r := tl;
+        Some x
+  ;;
+
+  let split ?pos ?len re s : _ gen = Search.split ?pos ?len re s |> gen_of_seq
+  let split_full ?pos ?len re s : _ gen = Search.split_full ?pos ?len re s |> gen_of_seq
+  let all ?pos ?len re s = Search.all ?pos ?len re s |> gen_of_seq
+  let matches ?pos ?len re s = Search.matches ?pos ?len re s |> gen_of_seq
+end
+
+module Group = Group
+
+(** {2 Deprecated functions} *)
+
+let split_full_seq = Search.split_full
+let split_seq = Search.split
+let matches_seq = Search.matches
+let all_seq = Search.all
+
+type 'a gen = 'a Gen.gen
+
+let all_gen = Gen.all
+let matches_gen = Gen.matches
+let split_gen = Gen.split
+let split_full_gen = Gen.split_full
+
+type substrings = Group.t
+
+let get = Group.get
+let get_ofs = Group.offset
+let get_all = Group.all
+let get_all_ofs = Group.all_offset
+let test = Group.test
+
+type markid = Mark.t
+
+let marked = Mark.test
+let mark_set = Mark.all
+
+type groups = Group.t
+
+module List = struct
+  let list_of_seq (s : 'a Seq.t) : 'a list =
+    Seq.fold_left (fun l x -> x :: l) [] s |> List.rev
+  ;;
+
+  let all ?pos ?len re s = Search.all ?pos ?len re s |> list_of_seq
+  let matches ?pos ?len re s = Search.matches ?pos ?len re s |> list_of_seq
+  let split_full ?pos ?len re s = Search.split_full ?pos ?len re s |> list_of_seq
+  let split ?pos ?len re s = Search.split ?pos ?len re s |> list_of_seq
+  let split_delim ?pos ?len re s = Search.split_delim ?pos ?len re s |> list_of_seq
+end
+
+include List
+
+include struct
+  open Compile
+
+  type nonrec re = re
+
+  let compile = compile
+  let pp_re = pp_re
+  let print_re = pp_re
+  let group_names = group_names
+  let group_count = group_count
+end
+
+module Seq = Search
+module Stream = Compile.Stream

unikernel/duniverse/ocaml-re/lib/core.mli

@@ -0,0 +1,813 @@
+(*
+   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]: code for creating and using regular expressions,
+    independently of regular expression syntax. *)
+
+(** Regular expression *)
+type t = Ast.t
+
+(** Compiled regular expression *)
+type re = Compile.re
+
+(** Manipulate matching groups. *)
+module Group : sig
+  (** Information about groups in a match. As is conventional, every
+      match implicitly has a group 0 that covers the whole match, and
+      explicit groups are numbered from 1. *)
+  type t = Group.t
+
+  (** Raise [Not_found] if the group did not match *)
+  val get : t -> int -> string
+
+  (** Similar to {!get}, but returns an option instead of using an exception. *)
+  val get_opt : t -> int -> string option
+
+  (** Raise [Not_found] if the group did not match *)
+  val offset : t -> int -> int * int
+
+  (** Similar to {!offset}, but returns an option instead of using an exception. *)
+  val offset_opt : t -> int -> (int * int) option
+
+  (** Return the start of the match. Raise [Not_found] if the group did not match. *)
+  val start : t -> int -> int
+
+  (** Similar to {!start_opt}, but returns an option instead of using an exception. *)
+  val start_opt : t -> int -> int option
+
+  (** Return the end of the match. Raise [Not_found] if the group did not match. *)
+  val stop : t -> int -> int
+
+  (** Similar to {!stop_opt}, but returns an option instead of using an exception. *)
+  val stop_opt : t -> int -> int option
+
+  (** Return the empty string for each group which did not match *)
+  val all : t -> string array
+
+  (** Return [(-1,-1)] for each group which did not match *)
+  val all_offset : t -> (int * int) array
+
+  (** Test whether a group matched *)
+  val test : t -> int -> bool
+
+  (** Returns the total number of groups defined - matched or not.
+      This function is experimental. *)
+  val nb_groups : t -> int
+
+  val pp : Format.formatter -> t -> unit
+end
+
+type groups = Group.t [@@ocaml.deprecated "Use Group.t"]
+
+(** {2 Compilation and execution of a regular expression} *)
+
+(** Compile a regular expression into an executable version that can be
+    used to match strings, e.g. with {!exec}. *)
+val compile : t -> re
+
+(** Return the number of capture groups (including the one
+    corresponding to the entire regexp). *)
+val group_count : re -> int
+
+(** Return named capture groups with their index. *)
+val group_names : re -> (string * int) list
+
+(** [exec re str] searches [str] for a match of the compiled expression [re],
+    and returns the matched groups if any.
+
+    More specifically, when a match exists, [exec] returns a match that
+    starts at the earliest position possible. If multiple such matches are
+    possible, the one specified by the match semantics described below is
+    returned.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile Re.(seq [str "//"; rep print ]);;
+      val regex : re = <abstr>
+
+      # Re.exec regex "// a C comment";;
+      - : Re.Group.t = <abstr>
+
+      # Re.exec regex "# a C comment?";;
+      Exception: Not_found
+
+      # Re.exec ~pos:1 regex "// a C comment";;
+      Exception: Not_found
+    ]}
+
+    @param pos optional beginning of the string (default 0)
+    @param len
+      length of the substring of [str] that can be matched (default [-1],
+      meaning to the end of the string)
+    @raise Not_found if the regular expression can't be found in [str] *)
+val exec
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int (** Default: -1 (until end of string) *)
+  -> re
+  -> string
+  -> Group.t
+
+(** Similar to {!exec}, but returns an option instead of using an exception.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile Re.(seq [str "//"; rep print ]);;
+      val regex : re = <abstr>
+
+      # Re.exec_opt regex "// a C comment";;
+      - : Re.Group.t option = Some <abstr>
+
+      # Re.exec_opt regex "# a C comment?";;
+      - : Re.Group.t option = None
+
+      # Re.exec_opt ~pos:1 regex "// a C comment";;
+      - : Re.Group.t option = None
+    ]} *)
+val exec_opt
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int (** Default: -1 (until end of string) *)
+  -> re
+  -> string
+  -> Group.t option
+
+(** Similar to {!exec}, but returns [true] if the expression matches,
+    and [false] if it doesn't. This function is more efficient than
+    calling {!exec} or {!exec_opt} and ignoring the returned group.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile Re.(seq [str "//"; rep print ]);;
+      val regex : re = <abstr>
+
+      # Re.execp regex "// a C comment";;
+      - : bool = true
+
+      # Re.execp ~pos:1 regex "// a C comment";;
+      - : bool = false
+    ]} *)
+val execp
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int (** Default: -1 (until end of string) *)
+  -> re
+  -> string
+  -> bool
+
+(** More detailed version of {!execp}. [`Full] is equivalent to [true],
+    while [`Mismatch] and [`Partial] are equivalent to [false], but [`Partial]
+    indicates the input string could be extended to create a match.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile Re.(seq [bos; str "// a C comment"]);;
+      val regex : re = <abstr>
+
+      # Re.exec_partial regex "// a C comment here.";;
+      - : [ `Full | `Mismatch | `Partial ] = `Full
+
+      # Re.exec_partial regex "// a C comment";;
+      - : [ `Full | `Mismatch | `Partial ] = `Partial
+
+      # Re.exec_partial regex "//";;
+      - : [ `Full | `Mismatch | `Partial ] = `Partial
+
+      # Re.exec_partial regex "# a C comment?";;
+      - : [ `Full | `Mismatch | `Partial ] = `Mismatch
+    ]} *)
+val exec_partial
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int (** Default: -1 (until end of string) *)
+  -> re
+  -> string
+  -> [ `Full | `Partial | `Mismatch ]
+
+(** More detailed version of {!exec_opt}. [`Full group] is equivalent to [Some group],
+    while [`Mismatch] and [`Partial _] are equivalent to [None], but [`Partial position]
+    indicates that the input string could be extended to create a match, and no match could
+    start in the input string before the given position.
+    This could be used to not have to search the entirety of the input if more
+    becomes available, and use the given position as the [?pos] argument. *)
+val exec_partial_detailed
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int (** Default: -1 (until end of string) *)
+  -> re
+  -> string
+  -> [ `Full of Group.t | `Partial of int | `Mismatch ]
+
+(** Marks *)
+module Mark : sig
+  (** Mark id *)
+  type t = Pmark.t
+
+  (** Tell if a mark was matched. *)
+  val test : Group.t -> t -> bool
+
+  module Set : Set.S with type elt = t
+
+  (** Return all the mark matched. *)
+  val all : Group.t -> Set.t
+
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+end
+
+(** {2 High Level Operations} *)
+
+type split_token =
+  [ `Text of string (** Text between delimiters *)
+  | `Delim of Group.t (** Delimiter *)
+  ]
+
+(** Repeatedly calls {!exec} on the given string, starting at given position and
+    length.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
+      val regex : re = <abstr>
+
+      # Re.all regex "my head, my shoulders, my knees, my toes ...";;
+      - : Re.Group.t list = [<abstr>; <abstr>; <abstr>; <abstr>]
+
+      # Re.all regex "My head, My shoulders, My knees, My toes ...";;
+      - : Re.Group.t list = []
+    ]} *)
+val all : ?pos:int -> ?len:int -> re -> string -> Group.t list
+
+type 'a gen = unit -> 'a option
+
+(** @deprecated Use {!module-Seq.all} instead. *)
+val all_gen : ?pos:int -> ?len:int -> re -> string -> Group.t gen
+[@@ocaml.deprecated "Use Seq.all"]
+
+(** @deprecated Use {!module-Seq.all} instead. *)
+val all_seq : ?pos:int -> ?len:int -> re -> string -> Group.t Seq.t
+[@@ocaml.deprecated "Use Seq.all"]
+
+(** Same as {!all}, but extracts the matched substring rather than returning
+    the whole group. This basically iterates over matched strings.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
+      val regex : re = <abstr>
+
+      # Re.matches regex "my head, my shoulders, my knees, my toes ...";;
+      - : string list = ["my head"; "my shoulders"; "my knees"; "my toes"]
+
+      # Re.matches regex "My head, My shoulders, My knees, My toes ...";;
+      - : string list = []
+
+      # Re.matches regex "my my my my head my 1 toe my ...";;
+      - : string list = ["my my"; "my my"]
+
+      # Re.matches ~pos:2 regex "my my my my head my +1 toe my ...";;
+      - : string list = ["my my"; "my head"]
+    ]} *)
+val matches : ?pos:int -> ?len:int -> re -> string -> string list
+
+(** @deprecated Use {!module-Seq.matches} instead. *)
+val matches_gen : ?pos:int -> ?len:int -> re -> string -> string gen
+[@@ocaml.deprecated "Use Seq.matches"]
+
+(** @deprecated Use {!module-Seq.matches} instead. *)
+val matches_seq : ?pos:int -> ?len:int -> re -> string -> string Seq.t
+[@@ocaml.deprecated "Use Seq.matches"]
+
+(** [split re s] splits [s] into chunks separated by [re]. It yields
+    the chunks themselves, not the separator. An occurence of the
+    separator at the beginning or the end of the string is ignoring.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile (Re.char ',');;
+      val regex : re = <abstr>
+
+      # Re.split regex "Re,Ocaml,Jerome Vouillon";;
+      - : string list = ["Re"; "Ocaml"; "Jerome Vouillon"]
+
+      # Re.split regex "No commas in this sentence.";;
+      - : string list = ["No commas in this sentence."]
+
+      # Re.split regex ",1,2,";;
+      - : string list = ["1"; "2"]
+
+      # Re.split ~pos:3 regex "1,2,3,4. Commas go brrr.";;
+      - : string list = ["3"; "4. Commas go brrr."]
+    ]}
+
+    {6 Zero-length patterns:}
+
+    Be careful when using [split] with zero-length patterns like [eol], [bow],
+    and [eow].  Because they don't have any width, they will still be present in
+    the result. (Note the position of the [\n] and space characters in the
+    output.)
+
+    {[
+      # Re.split (Re.compile Re.eol) "a\nb";;
+      - : string list = ["a"; "\nb"]
+
+      # Re.split (Re.compile Re.bow) "a b";;
+      - : string list = ["a "; "b"]
+
+      # Re.split (Re.compile Re.eow) "a b";;
+      - : string list = ["a"; " b"]
+    ]}
+
+    Compare this to the behavior of splitting on the char itself. (Note that
+    the delimiters are not present in the output.)
+
+    {[
+      # Re.split (Re.compile (Re.char '\n')) "a\nb";;
+      - : string list = ["a"; "b"]
+
+      # Re.split (Re.compile (Re.char ' ')) "a b";;
+      - : string list = ["a"; "b"]
+    ]} *)
+val split : ?pos:int -> ?len:int -> re -> string -> string list
+
+(** [split_delim re s] splits [s] into chunks separated by [re]. It
+    yields the chunks themselves, not the separator. Occurences of the
+    separator at the beginning or the end of the string will produce
+    empty chunks.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile (Re.char ',');;
+      val regex : re = <abstr>
+
+      # Re.split regex "Re,Ocaml,Jerome Vouillon";;
+      - : string list = ["Re"; "Ocaml"; "Jerome Vouillon"]
+
+      # Re.split regex "No commas in this sentence.";;
+      - : string list = ["No commas in this sentence."]
+
+      # Re.split regex ",1,2,";;
+      - : string list = [""; "1"; "2"; ""]
+
+      # Re.split ~pos:3 regex "1,2,3,4. Commas go brrr.";;
+      - : string list = ["3"; "4. Commas go brrr."]
+    ]}
+
+    {6 Zero-length patterns:}
+
+    Be careful when using [split_delim] with zero-length patterns like [eol],
+    [bow], and [eow].  Because they don't have any width, they will still be
+    present in the result. (Note the position of the [\n] and space characters
+    in the output.)
+
+    {[
+      # Re.split_delim (Re.compile Re.eol) "a\nb";;
+      - : string list = ["a"; "\nb"; ""]
+
+      # Re.split_delim (Re.compile Re.bow) "a b";;
+      - : string list = [""; "a "; "b"]
+
+      # Re.split_delim (Re.compile Re.eow) "a b";;
+      - : string list = ["a"; " b"; ""]
+    ]}
+
+    Compare this to the behavior of splitting on the char itself. (Note that
+    the delimiters are not present in the output.)
+
+    {[
+      # Re.split_delim (Re.compile (Re.char '\n')) "a\nb";;
+      - : string list = ["a"; "b"]
+
+      # Re.split_delim (Re.compile (Re.char ' ')) "a b";;
+      - : string list = ["a"; "b"]
+    ]} *)
+val split_delim : ?pos:int -> ?len:int -> re -> string -> string list
+
+(** @deprecated Use {!module-Seq.split} instead. *)
+val split_gen : ?pos:int -> ?len:int -> re -> string -> string gen
+[@@ocaml.deprecated "Use Seq.split"]
+
+(** @deprecated Use {!module-Seq.split} instead. *)
+val split_seq : ?pos:int -> ?len:int -> re -> string -> string Seq.t
+[@@ocaml.deprecated "Use Seq.split"]
+
+(** [split re s] splits [s] into chunks separated by [re]. It yields the chunks
+    along with the separators. For instance this can be used with a
+    whitespace-matching re such as ["[\t ]+"].
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile (Re.char ',');;
+      val regex : re = <abstr>
+
+      # Re.split_full regex "Re,Ocaml,Jerome Vouillon";;
+      - : Re.split_token list =
+        [`Text "Re"; `Delim <abstr>; `Text "Ocaml"; `Delim <abstr>;
+        `Text "Jerome Vouillon"]
+
+      # Re.split_full regex "No commas in this sentence.";;
+      - : Re.split_token list = [`Text "No commas in this sentence."]
+
+      # Re.split_full ~pos:3 regex "1,2,3,4. Commas go brrr.";;
+      - : Re.split_token list =
+        [`Delim <abstr>; `Text "3"; `Delim <abstr>; `Text "4. Commas go brrr."]
+    ]} *)
+val split_full : ?pos:int -> ?len:int -> re -> string -> split_token list
+
+(** @deprecated Use {!module-Seq.split_full} instead. *)
+val split_full_gen : ?pos:int -> ?len:int -> re -> string -> split_token gen
+[@@ocaml.deprecated "Use Seq.split_full"]
+
+(** @deprecated Use {!module-Seq.split_full} instead. *)
+val split_full_seq : ?pos:int -> ?len:int -> re -> string -> split_token Seq.t
+[@@ocaml.deprecated "Use Seq.split_full"]
+
+module Seq : sig
+  (** Same as {!module-Re.val-all} but returns an iterator.
+
+      {5 Examples:}
+      {[
+        # let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
+        val regex : re = <abstr>
+
+        # Re.Seq.all regex "my head, my shoulders, my knees, my toes ...";;
+        - : Re.Group.t Seq.t = <fun>
+      ]}
+      @since 1.10.0 *)
+  val all : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> Group.t Seq.t
+
+  (** Same as {!module-Re.val-matches}, but returns an iterator.
+
+      {5 Example:}
+      {[
+        # let regex = Re.compile Re.(seq [str "my"; blank; word(rep alpha)]);;
+        val regex : re = <abstr>
+
+        # Re.Seq.matches regex "my head, my shoulders, my knees, my toes ...";;
+        - : string Seq.t = <fun>
+      ]}
+      @since 1.10.0 *)
+  val matches : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> string Seq.t
+
+  (** Same as {!module-Re.val-split} but returns an iterator.
+
+      {5 Example:}
+      {[
+        # let regex = Re.compile (Re.char ',');;
+        val regex : re = <abstr>
+
+        # Re.Seq.split regex "Re,Ocaml,Jerome Vouillon";;
+        - : string Seq.t = <fun>
+      ]}
+      @since 1.10.0 *)
+  val split : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> string Seq.t
+
+  (** Same as {!module-Re.val-split_delim} but returns an iterator.
+
+      {5 Example:}
+      {[
+        # let regex = Re.compile (Re.char ',');;
+        val regex : re = <abstr>
+
+        # Re.Seq.split regex "Re,Ocaml,Jerome Vouillon";;
+        - : string Seq.t = <fun>
+      ]}
+      @since 1.11.1 *)
+  val split_delim : ?pos:int (** Default: 0 *) -> ?len:int -> re -> string -> string Seq.t
+
+  (** Same as {!module-Re.val-split_full} but returns an iterator.
+
+      {5 Example:}
+      {[
+        # let regex = Re.compile (Re.char ',');;
+        val regex : re = <abstr>
+
+        # Re.Seq.split_full regex "Re,Ocaml,Jerome Vouillon";;
+        - : Re.split_token Seq.t = <fun>
+      ]}
+      @since 1.10.0 *)
+  val split_full
+    :  ?pos:int (** Default: 0 *)
+    -> ?len:int
+    -> re
+    -> string
+    -> split_token Seq.t
+end
+
+(** {2 String expressions (literal match)} *)
+
+val str : string -> t
+val char : char -> t
+
+(** {2 Basic operations on regular expressions} *)
+
+(** Alternative.
+
+    [alt []] is equivalent to {!empty}.
+
+    By default, the leftmost match is preferred (see match semantics below). *)
+val alt : t list -> t
+
+(** Sequence *)
+val seq : t list -> t
+
+(** Match nothing *)
+val empty : t
+
+(** Empty word *)
+val epsilon : t
+
+(** 0 or more matches *)
+val rep : t -> t
+
+(** 1 or more matches *)
+val rep1 : t -> t
+
+(** [repn re i j] matches [re] at least [i] times
+    and at most [j] times, bounds included.
+    [j = None] means no upper bound. *)
+val repn : t -> int -> int option -> t
+
+(** 0 or 1 matches *)
+val opt : t -> t
+
+(** {2 String, line, word}
+
+    We define a word as a sequence of latin1 letters, digits and underscore. *)
+
+(** Beginning of line *)
+val bol : t
+
+(** End of line *)
+val eol : t
+
+(** Beginning of word *)
+val bow : t
+
+(** End of word *)
+val eow : t
+
+(** Beginning of string. This differs from {!start} because it matches
+    the beginning of the input string even when using [~pos] arguments:
+
+    {[
+      let b = execp (compile (seq [ bos; str "a" ])) "aa" ~pos:1 in
+      assert (not b)
+    ]} *)
+val bos : t
+
+(** End of string. This is different from {!stop} in the way described
+    in {!bos}. *)
+val eos : t
+
+(** Last end of line or end of string *)
+val leol : t
+
+(** Initial position. This differs from {!bos} because it takes into
+    account the [~pos] arguments:
+
+    {[
+      let b = execp (compile (seq [ start; str "a" ])) "aa" ~pos:1 in
+      assert b
+    ]} *)
+val start : t
+
+(** Final position. This is different from {!eos} in the way described
+    in {!start}. *)
+val stop : t
+
+(** Word *)
+val word : t -> t
+
+(** Not at a word boundary *)
+val not_boundary : t
+
+(** Only matches the whole string, i.e. [fun t -> seq [ bos; t; eos ]]. *)
+val whole_string : t -> t
+
+(** {2 Match semantics}
+
+    A regular expression frequently matches a string in multiple ways.  For
+    instance [exec (compile (opt (str "a"))) "ab"] can match "" or "a". Match
+    semantic can be modified with the functions below, allowing one to choose
+    which of these is preferable.
+
+    By default, the leftmost branch of alternations is preferred, and repetitions
+    are greedy.
+
+    Note that the existence of matches cannot be changed by specifying match
+    semantics.  [seq [ bos; str "a"; non_greedy (opt (str "b")); eos ]] will
+    match when applied to "ab". However if [seq [ bos; str "a"; non_greedy (opt
+   (str "b")) ]] is applied to "ab", it will match "a" rather than "ab".
+
+    Also note that multiple match semantics can conflict. In this case, the one
+    executed earlier takes precedence. For instance, any match of [shortest (seq
+   [ bos; group (rep (str "a")); group (rep (str "a")); eos ])] will always have
+    an empty first group. Conversely, if we use [longest] instead of [shortest],
+    the second group will always be empty. *)
+
+(** Longest match semantics. That is, matches will match as many bytes as
+    possible. If multiple choices match the maximum amount of bytes, the one
+    respecting the inner match semantics is preferred. *)
+val longest : t -> t
+
+(** Same as {!longest}, but matching the least number of bytes. *)
+val shortest : t -> t
+
+(** First match semantics for alternations (not repetitions). That is, matches
+    will prefer the leftmost branch of the alternation that matches the text. *)
+val first : t -> t
+
+(** Greedy matches for repetitions ({!opt}, {!rep}, {!rep1}, {!repn}): they will
+    match as many times as possible. *)
+val greedy : t -> t
+
+(** Non-greedy matches for repetitions ({!opt}, {!rep}, {!rep1}, {!repn}): they
+    will match as few times as possible. *)
+val non_greedy : t -> t
+
+(** {2 Groups (or submatches)} *)
+
+(** Delimit a group. The group is considered as matching if it is used at least
+    once (it may be used multiple times if is nested inside {!rep} for
+    instance). If it is used multiple times, the last match is what gets
+    captured. *)
+val group : ?name:string -> t -> t
+
+(** Remove all groups *)
+val no_group : t -> t
+
+(** When matching against [nest e], only the group matching in the
+    last match of e will be considered as matching.
+
+    For instance:
+    {[
+      let re = compile (rep1 (nest (alt [ group (str "a"); str "b" ]))) in
+      let group = Re.exec re "ab" in
+      assert (Group.get_opt group 1 = None);
+      (* same thing but without [nest] *)
+      let re = compile (rep1 (alt [ group (str "a"); str "b" ])) in
+      let group = Re.exec re "ab" in
+      assert (Group.get_opt group 1 = Some "a")
+    ]} *)
+val nest : t -> t
+
+(** Mark a regexp. the markid can then be used to know if this regexp was used. *)
+val mark : t -> Mark.t * t
+
+(** {2 Character sets} *)
+
+(** Any character of the string *)
+val set : string -> t
+
+(** Character ranges *)
+val rg : char -> char -> t
+
+(** Intersection of character sets *)
+val inter : t list -> t
+
+(** Difference of character sets *)
+val diff : t -> t -> t
+
+(** Complement of union *)
+val compl : t list -> t
+
+(** {2 Predefined character sets} *)
+
+(** Any character *)
+val any : t
+
+(** Any character but a newline *)
+val notnl : t
+
+val alnum : t
+val wordc : t
+val alpha : t
+val ascii : t
+val blank : t
+val cntrl : t
+val digit : t
+val graph : t
+val lower : t
+val print : t
+val punct : t
+val space : t
+val upper : t
+val xdigit : t
+
+(** {2 Case modifiers} *)
+
+(** Case sensitive matching. Note that this works on latin1, not ascii and not
+    utf8. *)
+val case : t -> t
+
+(** Case insensitive matching. Note that this works on latin1, not ascii and not
+    utf8. *)
+val no_case : t -> t
+
+(****)
+
+(** {2 Internal debugging} *)
+
+val pp : Format.formatter -> t -> unit
+val pp_re : Format.formatter -> re -> unit
+
+(** Alias for {!pp_re}. Deprecated *)
+val print_re : Format.formatter -> re -> unit
+
+(** {2 Experimental functions} *)
+
+(** [witness r] generates a string [s] such that [execp (compile r) s] is true.
+
+    Be warned that this function is buggy because it ignores zero-width
+    assertions like beginning of words. As a result it can generate incorrect
+    results. *)
+val witness : t -> string
+
+(** {2 Deprecated functions} *)
+
+(** Alias for {!Group.t}. Deprecated *)
+type substrings = Group.t [@@ocaml.deprecated "Use Group.t"]
+
+(** Same as {!Group.get}. Deprecated *)
+val get : Group.t -> int -> string
+[@@ocaml.deprecated "Use Group.get"]
+
+(** Same as {!Group.offset}. Deprecated *)
+val get_ofs : Group.t -> int -> int * int
+[@@ocaml.deprecated "Use Group.offset"]
+
+(** Same as {!Group.all}. Deprecated *)
+val get_all : Group.t -> string array
+[@@ocaml.deprecated "Use Group.all"]
+
+(** Same as {!Group.all_offset}. Deprecated *)
+val get_all_ofs : Group.t -> (int * int) array
+[@@ocaml.deprecated "Use Group.all_offset"]
+
+(** Same as {!Group.test}. Deprecated *)
+val test : Group.t -> int -> bool
+[@@ocaml.deprecated "Use Group.test"]
+
+(** Alias for {!Mark.t}. Deprecated *)
+type markid = Mark.t [@@ocaml.deprecated "Use Mark."]
+
+(** Same as {!Mark.test}. Deprecated *)
+val marked : Group.t -> Mark.t -> bool
+[@@ocaml.deprecated "Use Mark.test"]
+
+(** Same as {!Mark.all}. Deprecated *)
+val mark_set : Group.t -> Mark.Set.t
+[@@ocaml.deprecated "Use Mark.all"]
+
+module Stream : sig
+  (** An experimental for matching a regular expression by feeding individual
+      string chunks.
+
+      This module is not covered by semver's stability guarantee. *)
+
+  type t
+
+  type 'a feed =
+    | Ok of 'a
+    | No_match
+
+  val create : re -> t
+  val feed : t -> string -> pos:int -> len:int -> t feed
+
+  (** [finalize s ~pos ~len] feed [s] from [pos] to [len] and return whether
+      the regular expression matched. *)
+  val finalize : t -> string -> pos:int -> len:int -> bool
+
+  module Group : sig
+    (** Match a string against a regular expression with capture groups *)
+
+    type stream := t
+    type t
+
+    module Match : sig
+      type t
+
+      val get : t -> int -> string option
+      val test_mark : t -> Pmark.t -> bool
+    end
+
+    val create : stream -> t
+    val feed : t -> string -> pos:int -> len:int -> t feed
+    val finalize : t -> string -> pos:int -> len:int -> Match.t feed
+  end
+end

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

@@ -0,0 +1,250 @@
+module List = struct end
+open Import
+
+(*
+   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
+*)
+
+type c = int
+
+let equal_c = Int.equal
+let to_int x = x
+let of_int x = x
+let to_char t = Char.chr t
+let of_char c = Char.code c
+let null_char = -1
+
+type t = (c * c) list
+
+let compare_pair (x, y) (x', y') =
+  match Int.compare x x' with
+  | 0 -> Int.compare y y'
+  | x -> x
+;;
+
+let equal_pair (x, y) (x', y') = Int.equal x x' && Int.equal y y'
+let equal x y = List.equal ~eq:equal_pair x y
+let compare x y = List.compare ~cmp:compare_pair x y
+
+let rec union l l' =
+  match l, l' with
+  | _, [] -> l
+  | [], _ -> l'
+  | (c1, c2) :: r, (c1', c2') :: r' ->
+    if c2 + 1 < c1'
+    then (c1, c2) :: union r l'
+    else if c2' + 1 < c1
+    then (c1', c2') :: union l r'
+    else if c2 < c2'
+    then union r ((min c1 c1', c2') :: r')
+    else union ((min c1 c1', c2) :: r) r'
+;;
+
+let rec inter l l' =
+  match l, l' with
+  | _, [] -> []
+  | [], _ -> []
+  | (c1, c2) :: r, (c1', c2') :: r' ->
+    if c2 < c1'
+    then inter r l'
+    else if c2' < c1
+    then inter l r'
+    else if c2 < c2'
+    then (max c1 c1', c2) :: inter r l'
+    else (max c1 c1', c2') :: inter l r'
+;;
+
+let rec diff l l' =
+  match l, l' with
+  | _, [] -> l
+  | [], _ -> []
+  | (c1, c2) :: r, (c1', c2') :: r' ->
+    if c2 < c1'
+    then (c1, c2) :: diff r l'
+    else if c2' < c1
+    then diff l r'
+    else (
+      let r'' = if c2' < c2 then (c2' + 1, c2) :: r else r in
+      if c1 < c1' then (c1, c1' - 1) :: diff r'' r' else diff r'' r')
+;;
+
+let single =
+  let single c = [ c, c ] in
+  Dense_map.make (* an extra color for lnl *) ~size:257 ~f:single
+;;
+
+let csingle i = single (Char.code i)
+let add c l = union (single c) l
+let seq c c' = if c <= c' then [ c, c' ] else [ c', c ]
+
+let rec offset o l =
+  match l with
+  | [] -> []
+  | (c1, c2) :: r -> (c1 + o, c2 + o) :: offset o r
+;;
+
+let empty : t = []
+let cany = [ 0, 255 ]
+let union_all ts = List.fold_left ~init:empty ~f:union ts
+let intersect_all ts = List.fold_left ~init:cany ~f:inter ts
+
+let rec mem (c : int) s =
+  match s with
+  | [] -> false
+  | (c1, c2) :: rem -> if c <= c2 then c >= c1 else mem c rem
+;;
+
+(****)
+
+let rec hash_rec = function
+  | [] -> 0
+  | (i, j) :: r -> i + (13 * j) + (257 * hash_rec r)
+;;
+
+let hash l = hash_rec l land 0x3FFFFFFF
+
+(****)
+
+let print_one ch (c1, c2) =
+  if Int.equal c1 c2 then Format.fprintf ch "%d" c1 else Format.fprintf ch "%d-%d" c1 c2
+;;
+
+let pp ts = Fmt.list ~pp_sep:(Fmt.lit ", ") print_one ts
+
+let to_dyn t =
+  let open Dyn in
+  match t with
+  | [ (x, y) ] when Int.equal x y -> int x
+  | _ -> List.map t ~f:(fun (x, y) -> pair (int x) (int y)) |> list
+;;
+
+let rec iter t ~f =
+  match t with
+  | [] -> ()
+  | (x, y) :: xs ->
+    f x y;
+    iter xs ~f
+;;
+
+let one_char = function
+  | [ (i, j) ] when Int.equal i j -> Some i
+  | _ -> None
+;;
+
+module CSetMap = Map.Make (struct
+    type t = int * (int * int) list
+
+    let compare (i, u) (j, v) =
+      let c = Int.compare i j in
+      if c <> 0 then c else compare u v
+    ;;
+  end)
+
+let fold_right t ~init ~f = List.fold_right ~f:(fun (x, y) acc -> f x y acc) t ~init
+
+let is_empty = function
+  | [] -> true
+  | _ -> false
+;;
+
+let rec prepend s x l =
+  match s, l with
+  | [], _ -> l
+  | _r, [] -> []
+  | (_c, c') :: r, ([ (d, _d') ], _x') :: _r' when c' < d -> prepend r x l
+  | (c, c') :: r, ([ (d, d') ], x') :: r' ->
+    if c <= d
+    then
+      if c' < d'
+      then ([ d, c' ], x @ x') :: prepend r x (([ c' + 1, d' ], x') :: r')
+      else ([ d, d' ], x @ x') :: prepend s x r'
+    else if c > d'
+    then ([ d, d' ], x') :: prepend s x r'
+    else ([ d, c - 1 ], x') :: prepend s x (([ c, d' ], x') :: r')
+  | _ -> assert false
+;;
+
+let pick = function
+  | [] -> invalid_arg "Re_cset.pick"
+  | (x, _) :: _ -> x
+;;
+
+let cseq c c' = seq (of_char c) (of_char c')
+let rg = cseq
+let char = csingle
+let upper = union_all [ cseq 'A' 'Z'; cseq '\192' '\214'; cseq '\216' '\222' ]
+let clower = offset 32 upper
+let cdigit = cseq '0' '9'
+let ascii = cseq '\000' '\127'
+let cadd c s = add (of_char c) s
+let space = add (of_char ' ') (cseq '\009' '\013')
+let xdigit = union_all [ cdigit; cseq 'a' 'f'; cseq 'A' 'F' ]
+
+let calpha =
+  List.fold_right
+    ~f:cadd
+    [ '\170'; '\181'; '\186'; '\223'; '\255' ]
+    ~init:(union clower upper)
+;;
+
+let calnum = union calpha cdigit
+
+let case_insens s =
+  union_all [ s; offset 32 (inter s upper); offset (-32) (inter s clower) ]
+;;
+
+let cword = cadd '_' calnum
+let notnl = diff cany (csingle '\n')
+let nl = csingle '\n'
+
+let set str =
+  let s = ref empty in
+  for i = 0 to String.length str - 1 do
+    s := union (csingle str.[i]) !s
+  done;
+  !s
+;;
+
+let blank = set "\t "
+
+(* CR-someday rgrinberg: this [lower] doesn't match [clower] *)
+let lower = union_all [ rg 'a' 'z'; char '\181'; rg '\223' '\246'; rg '\248' '\255' ]
+let alpha = union_all [ lower; upper; char '\170'; char '\186' ]
+let alnum = union_all [ alpha; cdigit ]
+let wordc = union_all [ alnum; char '_' ]
+let cntrl = union_all [ rg '\000' '\031'; rg '\127' '\159' ]
+let graph = union_all [ rg '\033' '\126'; rg '\160' '\255' ]
+let print = union_all [ rg '\032' '\126'; rg '\160' '\255' ]
+
+let punct =
+  union_all
+    [ rg '\033' '\047'
+    ; rg '\058' '\064'
+    ; rg '\091' '\096'
+    ; rg '\123' '\126'
+    ; rg '\160' '\169'
+    ; rg '\171' '\180'
+    ; rg '\182' '\185'
+    ; rg '\187' '\191'
+    ; char '\215'
+    ; char '\247'
+    ]
+;;

unikernel/duniverse/ocaml-re/lib/cset.mli

@@ -0,0 +1,84 @@
+(*
+   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
+*)
+
+(* Character sets, represented as sorted list of intervals *)
+
+type c [@@immediate]
+
+val equal_c : c -> c -> bool
+val to_int : c -> int
+val of_int : int -> c
+val to_char : c -> char
+val of_char : char -> c
+
+type t
+
+(** special characters which isn't present in any set (not even in [cany]) *)
+val null_char : c
+
+val equal : t -> t -> bool
+val iter : t -> f:(c -> c -> unit) -> unit
+val union : t -> t -> t
+val union_all : t list -> t
+val intersect_all : t list -> t
+val inter : t -> t -> t
+val diff : t -> t -> t
+val empty : t
+val single : c -> t
+val add : c -> t -> t
+val mem : c -> t -> bool
+val case_insens : t -> t
+val cdigit : t
+val calpha : t
+val cword : t
+val notnl : t
+val ascii : t
+val nl : t
+val cseq : char -> char -> t
+val set : string -> t
+val blank : t
+val space : t
+val xdigit : t
+val lower : t
+val upper : t
+val alpha : t
+val alnum : t
+val wordc : t
+val cntrl : t
+val graph : t
+val print : t
+val punct : t
+val pp : t Fmt.t
+val one_char : t -> c option
+val fold_right : t -> init:'acc -> f:(c -> c -> 'acc -> 'acc) -> 'acc
+val hash : t -> int
+val compare : t -> t -> int
+
+module CSetMap : Map.S with type key = int * t
+
+val cany : t
+val csingle : char -> t
+val is_empty : t -> bool
+val prepend : t -> 'a list -> (t * 'a list) list -> (t * 'a list) list
+val pick : t -> c
+val offset : int -> t -> t
+val to_dyn : t -> Dyn.t

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

@@ -0,0 +1,4 @@
+let make ~size ~f =
+  let cache = Array.init size f in
+  fun i -> cache.(i)
+;;

unikernel/duniverse/ocaml-re/lib/dense_map.mli

@@ -0,0 +1 @@
+val make : size:int -> f:(int -> 'a) -> int -> 'a

unikernel/duniverse/ocaml-re/lib/dune

@@ -0,0 +1,9 @@
+(library
+ (name re)
+ (synopsis "Pure OCaml regular expression library")
+ (public_name re))
+
+(copy_files#
+ (enabled_if
+  (< %{ocaml_version} 5))
+ (files fake/*))

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

@@ -0,0 +1,26 @@
+type t =
+  | Int of int
+  | Tuple of t list
+  | Enum of string
+  | String of string
+  | List of t list
+  | Variant of string * t list
+  | Record of (string * t) list
+
+let variant x y = Variant (x, y)
+let list x = List x
+let int x = Int x
+let pair x y = Tuple [ x; y ]
+let record fields = Record fields
+let enum x = Enum x
+let string s = String s
+
+let result ok err = function
+  | Ok s -> variant "Ok" [ ok s ]
+  | Error e -> variant "Error" [ err e ]
+;;
+
+let option f = function
+  | None -> enum "None"
+  | Some s -> variant "Some" [ f s ]
+;;

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)

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

@@ -0,0 +1,41 @@
+(*
+   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
+*)
+
+(** Emacs-style regular expressions *)
+
+exception Parse_error
+
+(** Errors that can be raised during the parsing of the regular expression *)
+exception Not_supported
+
+(** Parsing of an Emacs-style regular expression *)
+val re : ?case:bool -> string -> Core.t
+
+val re_result : ?case:bool -> string -> (Core.t, [ `Not_supported | `Parse_error ]) result
+
+(** Regular expression compilation *)
+val compile : Core.t -> Core.re
+
+(** Same as [Core.compile] *)
+val compile_pat : ?case:bool -> string -> Core.re
+
+val re_no_emacs : case:bool -> string -> Core.t

unikernel/duniverse/ocaml-re/lib/fake/domain.ml

@@ -0,0 +1,5 @@
+module DLS = struct
+  let new_key f = ref (f())
+  let set x y = x := y
+  let get x = !x
+end

unikernel/duniverse/ocaml-re/lib/fake/mutex.ml

@@ -0,0 +1,26 @@
+(*
+   RE - A regular expression library
+
+   Copyright (C) 2025 Jerome Vouillon
+
+   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
+*)
+
+type t = unit
+
+let create _ = ()
+let lock _ = ()
+let unlock _ = ()

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

@@ -0,0 +1,51 @@
+(** Very small tooling for format printers. *)
+
+include Format
+
+type 'a t = Format.formatter -> 'a -> unit
+
+let list = pp_print_list
+let array ?pp_sep f fmt arr = list ?pp_sep f fmt (Array.to_list arr)
+let str = pp_print_string
+let sexp fmt s pp x = fprintf fmt "@[<3>(%s@ %a)@]" s pp x
+let bytes fmt t = Format.fprintf fmt "%S" (Bytes.to_string t)
+
+let pair pp1 pp2 fmt (v1, v2) =
+  pp1 fmt v1;
+  pp_print_space fmt ();
+  pp2 fmt v2
+;;
+
+let triple pp1 pp2 pp3 fmt (v1, v2, v3) =
+  pp1 fmt v1;
+  pp_print_space fmt ();
+  pp2 fmt v2;
+  pp_print_space fmt ();
+  pp3 fmt v3
+;;
+
+let opt f fmt x =
+  match x with
+  | None -> pp_print_string fmt "<None>"
+  | Some x -> fprintf fmt "%a" f x
+;;
+
+let int = pp_print_int
+
+let optint fmt = function
+  | None -> ()
+  | Some i -> fprintf fmt "@ %d" i
+;;
+
+let char fmt c = Format.fprintf fmt "%c" c
+let bool = Format.pp_print_bool
+let lit s fmt () = pp_print_string fmt s
+
+let to_to_string pp x =
+  let b = Buffer.create 16 in
+  let fmt = Format.formatter_of_buffer b in
+  pp fmt x;
+  Buffer.contents b
+;;
+
+let quoted_string fmt s = Format.fprintf fmt "%S" s

unikernel/duniverse/ocaml-re/lib/fmt.mli

@@ -0,0 +1,18 @@
+type formatter := Format.formatter
+type 'a t = formatter -> 'a -> unit
+
+val sexp : formatter -> string -> 'a t -> 'a -> unit
+val str : string t
+val optint : int option t
+val opt : 'a t -> 'a option t
+val char : char t
+val bool : bool t
+val int : int t
+val pair : 'a t -> 'b t -> ('a * 'b) t
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+val list : ?pp_sep:unit t -> 'a t -> 'a list t
+val bytes : Bytes.t t
+val array : ?pp_sep:unit t -> 'a t -> 'a array t
+val lit : string -> unit t
+val to_to_string : 'a t -> 'a -> string
+val quoted_string : string t

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

@@ -0,0 +1,337 @@
+(*
+   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 = Parse_buffer.Parse_error
+
+type enclosed =
+  | Char of char
+  | Range of char * char
+
+type piece =
+  | Exactly of char
+  | Any_of of enclosed list
+  | Any_but of enclosed list
+  | One
+  | Many
+  | ManyMany
+
+type t = piece list
+
+let of_string ~double_asterisk s : t =
+  let buf = Parse_buffer.create s in
+  let eos () = Parse_buffer.eos buf in
+  let read c = Parse_buffer.accept buf c in
+  let char () =
+    ignore (read '\\' : bool);
+    if eos () then raise Parse_error;
+    Parse_buffer.get buf
+  in
+  let enclosed () : enclosed list =
+    let rec loop s =
+      (* This returns the list in reverse order, but order isn't important
+         anyway *)
+      if s <> [] && read ']'
+      then s
+      else (
+        let c = char () in
+        if not (read '-')
+        then loop (Char c :: s)
+        else if read ']'
+        then Char c :: Char '-' :: s
+        else (
+          let c' = char () in
+          loop (Range (c, c') :: s)))
+    in
+    loop []
+  in
+  let piece acc =
+    if double_asterisk && Parse_buffer.accept_s buf "/**"
+    then ManyMany :: (if eos () then Exactly '/' :: acc else acc)
+    else if read '*'
+    then (if double_asterisk && read '*' then ManyMany else Many) :: acc
+    else if read '?'
+    then One :: acc
+    else if not (read '[')
+    then Exactly (char ()) :: acc
+    else if read '^' || read '!'
+    then Any_but (enclosed ()) :: acc
+    else Any_of (enclosed ()) :: acc
+  in
+  let rec loop pieces = if eos () then List.rev pieces else loop (piece pieces) in
+  loop []
+;;
+
+let mul l l' = List.flatten (List.map (fun s -> List.map (fun s' -> s ^ s') l') l)
+
+let explode str =
+  let l = String.length str in
+  let rec expl inner s i acc beg =
+    if i >= l
+    then (
+      if inner then raise Parse_error;
+      mul beg [ String.sub str s (i - s) ], i)
+    else (
+      match str.[i] with
+      | '\\' -> expl inner s (i + 2) acc beg
+      | '{' ->
+        let t, i' = expl true (i + 1) (i + 1) [] [ "" ] in
+        expl inner i' i' acc (mul beg (mul [ String.sub str s (i - s) ] t))
+      | ',' when inner ->
+        expl inner (i + 1) (i + 1) (mul beg [ String.sub str s (i - s) ] @ acc) [ "" ]
+      | '}' when inner -> mul beg [ String.sub str s (i - s) ] @ acc, i + 1
+      | _ -> expl inner s (i + 1) acc beg)
+  in
+  List.rev (fst (expl false 0 0 [] [ "" ]))
+;;
+
+module State = struct
+  type t =
+    { re_pieces : Re.t list (* last piece at head of list. *)
+    ; remaining : piece list (* last piece at tail of list. *)
+    ; am_at_start_of_pattern : bool (* true at start of pattern *)
+    ; am_at_start_of_component : bool
+        (* true at start of pattern or immediately
+           after '/' *)
+    ; pathname : bool
+    ; match_backslashes : bool
+    ; period : bool
+    }
+
+  let create ~period ~pathname ~match_backslashes remaining =
+    { re_pieces = []
+    ; am_at_start_of_pattern = true
+    ; am_at_start_of_component = true
+    ; pathname
+    ; match_backslashes
+    ; period
+    ; remaining
+    }
+  ;;
+
+  let explicit_period t =
+    t.period && (t.am_at_start_of_pattern || (t.am_at_start_of_component && t.pathname))
+  ;;
+
+  let explicit_slash t = t.pathname
+  let slashes t = if t.match_backslashes then [ '/'; '\\' ] else [ '/' ]
+
+  let append ?(am_at_start_of_component = false) t piece =
+    { t with
+      re_pieces = piece :: t.re_pieces
+    ; am_at_start_of_pattern = false
+    ; am_at_start_of_component
+    }
+  ;;
+
+  let to_re t = Re.seq (List.rev t.re_pieces)
+
+  let next t =
+    match t.remaining with
+    | [] -> None
+    | piece :: remaining -> Some (piece, { t with remaining })
+  ;;
+end
+
+let one ~explicit_slash ~slashes ~explicit_period =
+  Re.compl
+    (List.concat
+       [ (if explicit_slash then List.map Re.char slashes else [])
+       ; (if explicit_period then [ Re.char '.' ] else [])
+       ])
+;;
+
+let enclosed enclosed =
+  match enclosed with
+  | Char c -> Re.char c
+  | Range (low, high) -> Re.rg low high
+;;
+
+let enclosed_set ~explicit_slash ~slashes ~explicit_period kind set =
+  let set = List.map enclosed set in
+  let enclosure =
+    match kind with
+    | `Any_of -> Re.alt set
+    | `Any_but -> Re.compl set
+  in
+  Re.inter [ enclosure; one ~explicit_slash ~slashes ~explicit_period ]
+;;
+
+let exactly state c =
+  let slashes = State.slashes state in
+  let am_at_start_of_component = List.mem c slashes in
+  let chars = if am_at_start_of_component then slashes else [ c ] in
+  State.append state (Re.alt (List.map Re.char chars)) ~am_at_start_of_component
+;;
+
+let many_many state =
+  let explicit_period = state.State.period && state.State.pathname in
+  let first_explicit_period = State.explicit_period state in
+  let slashes = State.slashes state in
+  let match_component ~explicit_period =
+    Re.seq
+      [ one ~explicit_slash:true ~slashes ~explicit_period
+      ; Re.rep (one ~explicit_slash:true ~slashes ~explicit_period:false)
+      ]
+  in
+  (* We must match components individually when [period] flag is set,
+     making sure to not match ["foo/.bar"]. *)
+  State.append
+    state
+    (Re.seq
+       [ Re.opt (match_component ~explicit_period:first_explicit_period)
+       ; Re.rep
+           (Re.seq
+              [ Re.alt (List.map Re.char slashes)
+              ; Re.opt (match_component ~explicit_period)
+              ])
+       ])
+;;
+
+let many (state : State.t) =
+  let explicit_slash = State.explicit_slash state in
+  let explicit_period = State.explicit_period state in
+  let slashes = State.slashes state in
+  (* Whether we must explicitly match period depends on the surrounding
+     characters, but slashes are easy to explicit match. This conditional
+     splits out some simple cases. *)
+  if not explicit_period
+  then State.append state (Re.rep (one ~explicit_slash ~slashes ~explicit_period))
+  else if not explicit_slash
+  then
+    (* In this state, we explicitly match periods only at the very beginning *)
+    State.append
+      state
+      (Re.opt
+         (Re.seq
+            [ one ~explicit_slash:false ~slashes ~explicit_period
+            ; Re.rep (one ~explicit_slash:false ~slashes ~explicit_period:false)
+            ]))
+  else (
+    let not_empty =
+      Re.seq
+        [ one ~explicit_slash:true ~slashes ~explicit_period:true
+        ; Re.rep (one ~explicit_slash:true ~slashes ~explicit_period:false)
+        ]
+    in
+    (* [maybe_empty] is the default translation of Many, except in some special
+       cases. *)
+    let maybe_empty = Re.opt not_empty in
+    let enclosed_set state kind set =
+      State.append
+        state
+        (Re.alt
+           [ enclosed_set kind set ~explicit_slash:true ~slashes ~explicit_period:true
+           ; Re.seq
+               [ not_empty
+               ; (* Since [not_empty] matched, subsequent dots are not leading. *)
+                 enclosed_set
+                   kind
+                   set
+                   ~explicit_slash:true
+                   ~slashes
+                   ~explicit_period:false
+               ]
+           ])
+    in
+    let rec lookahead state =
+      match State.next state with
+      | None -> State.append state maybe_empty
+      (* glob ** === glob * . *)
+      | Some (Many, state) -> lookahead state
+      | Some (Exactly c, state) ->
+        let state = State.append state (if c = '.' then not_empty else maybe_empty) in
+        exactly state c
+      (* glob *? === glob ?* *)
+      | Some (One, state) -> State.append state not_empty
+      | Some (Any_of enclosed, state) -> enclosed_set state `Any_of enclosed
+      | Some (Any_but enclosed, state) -> enclosed_set state `Any_but enclosed
+      (* * then ** === ** *)
+      | Some (ManyMany, state) -> many_many state
+    in
+    lookahead state)
+;;
+
+let piece state piece =
+  let explicit_slash = State.explicit_slash state in
+  let explicit_period = State.explicit_period state in
+  let slashes = State.slashes state in
+  match piece with
+  | One -> State.append state (one ~explicit_slash ~slashes ~explicit_period)
+  | Many -> many state
+  | Any_of enclosed ->
+    State.append
+      state
+      (enclosed_set `Any_of ~explicit_slash ~slashes ~explicit_period enclosed)
+  | Any_but enclosed ->
+    State.append
+      state
+      (enclosed_set `Any_but ~explicit_slash ~slashes ~explicit_period enclosed)
+  | Exactly c -> exactly state c
+  | ManyMany -> many_many state
+;;
+
+let glob ~pathname ~match_backslashes ~period glob =
+  let rec loop state =
+    match State.next state with
+    | None -> State.to_re state
+    | Some (p, state) -> loop (piece state p)
+  in
+  loop (State.create ~pathname ~match_backslashes ~period glob)
+;;
+
+let glob
+  ?(anchored = false)
+  ?(pathname = true)
+  ?(match_backslashes = false)
+  ?(period = true)
+  ?(expand_braces = false)
+  ?(double_asterisk = true)
+  s
+  =
+  let to_re s =
+    let re = glob ~pathname ~match_backslashes ~period (of_string ~double_asterisk s) in
+    if anchored then Re.whole_string re else re
+  in
+  if expand_braces then Re.alt (List.map to_re (explode s)) else to_re s
+;;
+
+let glob_result
+  ?anchored
+  ?pathname
+  ?match_backslashes
+  ?period
+  ?expand_braces
+  ?double_asterisk
+  s
+  =
+  match
+    glob ?anchored ?pathname ?match_backslashes ?period ?expand_braces ?double_asterisk s
+  with
+  | re -> Ok re
+  | exception Parse_error -> Error `Parse_error
+;;
+
+let glob' ?anchored period s = glob ?anchored ~period s
+let globx ?anchored s = glob ?anchored ~expand_braces:true s
+let globx' ?anchored period s = glob ?anchored ~expand_braces:true ~period s

unikernel/duniverse/ocaml-re/lib/glob.mli

@@ -0,0 +1,95 @@
+(*
+   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
+*)
+
+(** Shell-style regular expressions *)
+
+exception Parse_error
+
+(** Implements the semantics of shells patterns. The returned regular
+    expression is unanchored by default.
+
+    Character '*' matches any sequence of characters and character
+    '?' matches a single character.
+    A sequence '[...]' matches any one of the enclosed characters.
+    A sequence '[^...]' or '[!...]' matches any character *but* the enclosed characters.
+    A backslash escapes the following character.  The last character of the string cannot
+    be a backslash.
+
+    [anchored] controls whether the regular expression will only match entire
+    strings. Defaults to false.
+
+    [pathname]: If this flag is set, match a slash in string only with a slash in pattern
+    and not by an asterisk ('*') or a question mark ('?') metacharacter, nor by a bracket
+    expression ('[]') containing a slash. Defaults to true.
+
+    [match_backslashes]: If this flag is set, a forward slash will also match a
+    backslash (useful when globbing Windows paths). Note that a backslash in the
+    pattern will continue to escape the following character. Defaults to
+    [false].
+
+    [period]: If this flag is set, a leading period in string has to be matched exactly by
+    a period in pattern. A period is considered to be leading if it is the first
+    character in string, or if both [pathname] is set and the period immediately follows a
+    slash. Defaults to true.
+
+    If [expand_braces] is true, braced sets will expand into multiple globs,
+    e.g. a\{x,y\}b\{1,2\} matches axb1, axb2, ayb1, ayb2.  As specified for bash, brace
+    expansion is purely textual and can be nested. Defaults to false.
+
+    [double_asterisk]: If this flag is set, double asterisks ('**') will match slash
+    characters, even if [pathname] is set. The [period] flag still applies. Default to
+    true. *)
+val glob
+  :  ?anchored:bool
+  -> ?pathname:bool
+  -> ?match_backslashes:bool
+  -> ?period:bool
+  -> ?expand_braces:bool
+  -> ?double_asterisk:bool
+  -> string
+  -> Core.t
+
+val glob_result
+  :  ?anchored:bool
+  -> ?pathname:bool
+  -> ?match_backslashes:bool
+  -> ?period:bool
+  -> ?expand_braces:bool
+  -> ?double_asterisk:bool
+  -> string
+  -> (Core.t, [ `Parse_error ]) result
+
+(** Same, but allows to choose whether dots at the beginning of a
+    file name need to be explicitly matched (true) or not (false)
+
+    @deprecated Use [glob ~period]. *)
+val glob' : ?anchored:bool -> bool -> string -> Core.t
+
+(** This version of [glob] also recognizes the pattern \{..,..\}
+
+    @deprecated Prefer [glob ~expand_braces:true]. *)
+val globx : ?anchored:bool -> string -> Core.t
+
+(** This version of [glob'] also recognizes the pattern \{..,..\}
+
+    @deprecated Prefer [glob ~expand_braces:true ~period]. *)
+val globx' : ?anchored:bool -> bool -> string -> Core.t

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

@@ -0,0 +1,103 @@
+(* Result of a successful match. *)
+type t =
+  { (* Input string. Matched strings are substrings of s *)
+    s : string
+      (* Mapping from group indices to positions in gpos. group i has positions 2*i
+         - 1, 2*i + 1 in gpos. If the group wasn't matched, then its corresponding
+           values in marks will be -1,-1 *)
+  ; marks : Mark_infos.t
+  ; (* Marks positions. i.e. those marks created with Re.marks *)
+    pmarks : Pmark.Set.t
+  ; (* Group positions. Adjacent elements are (start, stop) of group match.
+       indexed by the values in marks. So group i in an re would be the substring:
+
+       start = t.gpos.(marks.(2*i)) - 1
+       stop = t.gpos.(marks.(2*i + 1)) - 1 *)
+    gpos : int array
+  ; (* Number of groups the regular expression contains. Matched or not *)
+    gcount : int
+  }
+
+let create s ~gcount ~gpos marks pmarks = { s; gcount; gpos; marks; pmarks }
+
+module Offset = struct
+  type t = int
+
+  let absent = -1
+  let is_present t = t >= 0
+  let get_no_check t = t
+end
+
+let start_offset t i =
+  let i = Mark_infos.start_offset t.marks i in
+  if Mark_infos.Offset.is_present i
+  then t.gpos.(Mark_infos.Offset.get_no_check i)
+  else Offset.absent
+;;
+
+let stop_offset t i =
+  let i = Mark_infos.stop_offset t.marks i in
+  if Mark_infos.Offset.is_present i
+  then t.gpos.(Mark_infos.Offset.get_no_check i)
+  else Offset.absent
+;;
+
+let offset_opt t i =
+  Mark_infos.offset t.marks i
+  |> Option.map (fun (start, stop) -> t.gpos.(start), t.gpos.(stop))
+;;
+
+let or_not_found = function
+  | None -> raise Not_found
+  | Some s -> s
+;;
+
+let offset t i = offset_opt t i |> or_not_found
+
+let get_opt t i =
+  offset_opt t i |> Option.map (fun (p1, p2) -> String.sub t.s p1 (p2 - p1))
+;;
+
+let pmarks t = t.pmarks
+let get t i = get_opt t i |> or_not_found
+let start_opt subs i = offset_opt subs i |> Option.map fst
+let start subs i = start_opt subs i |> or_not_found
+let stop_opt subs i = offset_opt subs i |> Option.map snd
+let stop subs i = stop_opt subs i |> or_not_found
+let test t i = Mark_infos.test t.marks i
+let get_opt t i = if test t i then Some (get t i) else None
+let dummy_offset = -1, -1
+
+let all_offset t =
+  let res = Array.make t.gcount dummy_offset in
+  Mark_infos.iteri t.marks ~f:(fun i start stop ->
+    let p1 = t.gpos.(start) in
+    let p2 = t.gpos.(stop) in
+    res.(i) <- p1, p2);
+  res
+;;
+
+let dummy_string = ""
+
+let all t =
+  let res = Array.make t.gcount dummy_string in
+  Mark_infos.iteri t.marks ~f:(fun i start stop ->
+    let p1 = t.gpos.(start) in
+    let p2 = t.gpos.(stop) in
+    res.(i) <- String.sub t.s p1 (p2 - p1));
+  res
+;;
+
+let pp fmt t =
+  let matches =
+    let offsets = all_offset t in
+    let strs = all t in
+    Array.to_list (Array.init (Array.length strs) (fun i -> strs.(i), offsets.(i)))
+  in
+  let open Format in
+  let open Fmt in
+  let pp_match fmt (str, (start, stop)) = fprintf fmt "@[(%s (%d %d))@]" str start stop in
+  sexp fmt "Group" (list pp_match) matches
+;;
+
+let nb_groups t = t.gcount

unikernel/duniverse/ocaml-re/lib/group.mli

@@ -0,0 +1,54 @@
+(** Information about groups in a match. *)
+
+(** Result of a successful match. *)
+type t
+
+val create : string -> gcount:int -> gpos:int array -> Mark_infos.t -> Pmark.Set.t -> t
+
+(** Raise [Not_found] if the group did not match *)
+val get : t -> int -> string
+
+(** Similar to {!get}, but returns an option instead of using an exception. *)
+val get_opt : t -> int -> string option
+
+(** Raise [Not_found] if the group did not match *)
+val offset : t -> int -> int * int
+
+val offset_opt : t -> int -> (int * int) option
+
+(** Return the start of the match. Raise [Not_found] if the group did not match. *)
+val start : t -> int -> int
+
+val start_opt : t -> int -> int option
+
+(** Return the end of the match. Raise [Not_found] if the group did not match. *)
+val stop : t -> int -> int
+
+val stop_opt : t -> int -> int option
+
+(** Return the empty string for each group which did not match *)
+val all : t -> string array
+
+(** Return [(-1,-1)] for each group which did not match *)
+val all_offset : t -> (int * int) array
+
+(** Test whether a group matched *)
+val test : t -> int -> bool
+
+val pmarks : t -> Pmark.Set.t
+
+(** Returns the total number of groups defined - matched or not.
+    This function is experimental. *)
+val nb_groups : t -> int
+
+val pp : t Fmt.t
+
+module Offset : sig
+  type t
+
+  val is_present : t -> bool
+  val get_no_check : t -> int
+end
+
+val start_offset : t -> int -> Offset.t
+val stop_offset : t -> int -> Offset.t

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

@@ -0,0 +1,155 @@
+open Import
+
+module Array = struct
+  type nonrec t = Bytes.t
+
+  let words = 8
+  let[@inline] length t = Bytes.length t / words
+  let[@inline] unsafe_get t i = Int64.to_int (Bytes.get_int64_ne t (i * words))
+  let[@inline] unsafe_set t i x = Bytes.set_int64_ne t (i * words) (Int64.of_int x)
+
+  let[@inline] make len x =
+    let t = Bytes.create (len * words) in
+    for i = 0 to length t - 1 do
+      unsafe_set t i x
+    done;
+    t
+  ;;
+
+  let[@inline] make_absent len = Bytes.make (len * words) '\255'
+  let clear t = Bytes.fill t 0 (Bytes.length t) '\255'
+
+  let fold_left t ~init ~f =
+    let init = ref init in
+    for i = 0 to length t - 1 do
+      init := f !init (unsafe_get t i)
+    done;
+    !init
+  ;;
+end
+
+(* A specialized hash table that makes the following trade-offs:
+   - Open addresing. Bucketing is quite memory intensive and dune is already
+     a memory hog.
+   - No boxing for empty slots. We make use of the fact that id's are never
+     negative to achieve this.
+   - No saving of the hash. Recomputing the hash for id's is a no-op.
+*)
+
+type nonrec table =
+  { mutable table : Array.t
+  ; mutable size : int
+  }
+
+type t = table Option.t ref
+
+let init t =
+  if Option.is_none !t then t := Option.some { size = 0; table = Array.make 0 (-1) };
+  Option.get !t
+;;
+
+let[@inline] should_grow t =
+  let slots = Array.length t.table in
+  slots = 0 || (t.size > 0 && slots / t.size < 2)
+;;
+
+let absent = -1
+
+let () =
+  let x = Array.make_absent 1 in
+  assert (Array.unsafe_get x 0 = absent)
+;;
+
+let create () = ref None
+
+let[@inline] index_of_offset slots index i =
+  let i = index + !i in
+  if i >= slots then i - slots else i
+;;
+
+let clear t =
+  match !t with
+  | None -> ()
+  | Some t ->
+    t.size <- 0;
+    Array.clear t.table
+;;
+
+let add t x =
+  let hash = Int.hash x in
+  let slots = Array.length t.table in
+  let index = hash land (slots - 1) in
+  let inserting = ref true in
+  let i = ref 0 in
+  while !inserting do
+    let idx = index_of_offset slots index i in
+    let elem = Array.unsafe_get t.table idx in
+    if elem = absent
+    then (
+      Array.unsafe_set t.table idx x;
+      inserting := false)
+    else incr i
+  done;
+  t.size <- t.size + 1
+;;
+
+let resize t =
+  let old_table = t.table in
+  let slots = Array.length old_table in
+  let table = Array.make_absent (if slots = 0 then 1 else slots lsl 1) in
+  t.table <- table;
+  for i = 0 to slots - 1 do
+    let elem = Array.unsafe_get old_table i in
+    if elem <> absent then add t elem
+  done
+;;
+
+let add t x =
+  let t = init t in
+  if should_grow t then resize t;
+  add t x
+;;
+
+let[@inline] is_empty t =
+  let t = !t in
+  if Option.is_none t
+  then true
+  else (
+    let t = Option.get t in
+    t.size = 0)
+;;
+
+let mem t x =
+  let t = !t in
+  if Option.is_none t || (Option.get t).size = 0
+  then false
+  else (
+    let t = Option.get t in
+    let hash = Int.hash x in
+    let slots = Array.length t.table in
+    let index = hash land (slots - 1) in
+    let i = ref 0 in
+    let found = ref false in
+    while (not !found) && !i < slots do
+      let idx = index_of_offset slots index i in
+      let elem = Array.unsafe_get t.table idx in
+      if Int.equal elem x
+      then found := true
+      else if Int.equal elem absent
+      then i := slots
+      else incr i
+    done;
+    !found)
+;;
+
+let pp fmt t =
+  let { table; size } = init t in
+  let table =
+    Array.fold_left table ~init:[] ~f:(fun acc i -> if i = absent then acc else i :: acc)
+    |> List.rev
+    |> Stdlib.Array.of_list
+  in
+  let table fmt () = Fmt.sexp fmt "table" Fmt.(array int) table in
+  let size fmt () = Fmt.sexp fmt "size" Fmt.int size in
+  Format.fprintf fmt "%a@.%a@." table () size ()
+;;

unikernel/duniverse/ocaml-re/lib/hash_set.mli

@@ -0,0 +1,8 @@
+type t
+
+val create : unit -> t
+val is_empty : t -> bool
+val add : t -> int -> unit
+val mem : t -> int -> bool
+val clear : t -> unit
+val pp : t Fmt.t

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

@@ -0,0 +1,24 @@
+module List = Stdlib.ListLabels
+
+module Poly = struct
+  let equal = ( = )
+  let compare = compare
+end
+
+module Phys_equal = struct
+  let equal = ( == )
+end
+
+let ( = ) = Int.equal
+let ( == ) = [ `Use_phys_equal ]
+let ( < ) (x : int) (y : int) = x < y
+let ( > ) (x : int) (y : int) = x > y
+let min = Int.min
+let max = Int.max
+let compare = Int.compare
+
+module Int = struct
+  let[@warning "-32"] hash (x : int) = Hashtbl.hash x
+
+  include Stdlib.Int
+end

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

@@ -0,0 +1,55 @@
+open Import
+
+type t = int array
+
+let make marks =
+  let len = 1 + List.fold_left ~f:(fun ma (i, _) -> max ma i) ~init:(-1) marks in
+  let t = Array.make len (-1) in
+  let set (i, v) = t.(i) <- v in
+  List.iter ~f:set marks;
+  t
+;;
+
+let test t i = if 2 * i >= Array.length t then false else t.(2 * i) <> -1
+
+module Offset = struct
+  type t = int
+
+  let is_present t = t >= 0
+  let get_no_check t = t
+end
+
+let start_offset t i =
+  let start_i = 2 * i in
+  if start_i + 1 >= Array.length t then -1 else t.(start_i)
+;;
+
+let stop_offset t i =
+  let stop_i = (2 * i) + 1 in
+  if stop_i >= Array.length t then -1 else t.(stop_i)
+;;
+
+let offset t i =
+  let start_i = 2 * i in
+  let stop_i = start_i + 1 in
+  if stop_i >= Array.length t
+  then None
+  else (
+    let start = t.(start_i) in
+    if start = -1
+    then None
+    else (
+      let stop = t.(stop_i) in
+      Some (start, stop)))
+;;
+
+let iteri t ~f =
+  for i = 0 to (Array.length t / 2) - 1 do
+    let idx = 2 * i in
+    let start = t.(idx) in
+    if start <> -1
+    then (
+      let stop = t.(idx + 1) in
+      f i start stop)
+  done
+;;

unikernel/duniverse/ocaml-re/lib/mark_infos.mli

@@ -0,0 +1,17 @@
+(** store mark information for groups in an array *)
+type t
+
+val make : (int * int) list -> t
+val offset : t -> int -> (int * int) option
+val test : t -> int -> bool
+val iteri : t -> f:(int -> int -> int -> unit) -> unit
+
+module Offset : sig
+  type t
+
+  val is_present : t -> bool
+  val get_no_check : t -> int
+end
+
+val start_offset : t -> int -> Offset.t
+val stop_offset : t -> int -> Offset.t

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

@@ -0,0 +1,67 @@
+type t =
+  { str : string
+  ; mutable pos : int
+  }
+
+exception Parse_error
+
+let create str = { str; pos = 0 }
+let unget t = t.pos <- t.pos - 1
+let junk t = t.pos <- t.pos + 1
+let eos t = t.pos = String.length t.str
+let test t c = (not (eos t)) && t.str.[t.pos] = c
+
+let test2 t c c' =
+  t.pos + 1 < String.length t.str && t.str.[t.pos] = c && t.str.[t.pos + 1] = c'
+;;
+
+let accept t c =
+  let r = test t c in
+  if r then t.pos <- t.pos + 1;
+  r
+;;
+
+let get t =
+  let r = t.str.[t.pos] in
+  t.pos <- t.pos + 1;
+  r
+;;
+
+let accept_s t s' =
+  let len = String.length s' in
+  try
+    for j = 0 to len - 1 do
+      (* CR-someday rgrinberg: stop relying on bound checks *)
+      try if s'.[j] <> t.str.[t.pos + j] then raise_notrace Exit with
+      | _ -> raise_notrace Exit
+    done;
+    t.pos <- t.pos + len;
+    true
+  with
+  | Exit -> false
+;;
+
+let rec integer' t i =
+  if eos t
+  then Some i
+  else (
+    match get t with
+    | '0' .. '9' as d ->
+      let i' = (10 * i) + (Char.code d - Char.code '0') in
+      if i' < i then raise Parse_error;
+      integer' t i'
+    | _ ->
+      unget t;
+      Some i)
+;;
+
+let integer t =
+  if eos t
+  then None
+  else (
+    match get t with
+    | '0' .. '9' as d -> integer' t (Char.code d - Char.code '0')
+    | _ ->
+      unget t;
+      None)
+;;

unikernel/duniverse/ocaml-re/lib/parse_buffer.mli

@@ -0,0 +1,14 @@
+type t
+
+exception Parse_error
+
+val create : string -> t
+val junk : t -> unit
+val unget : t -> unit
+val eos : t -> bool
+val test : t -> char -> bool
+val test2 : t -> char -> char -> bool
+val get : t -> char
+val accept : t -> char -> bool
+val accept_s : t -> string -> bool
+val integer : t -> int option

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

@@ -0,0 +1,179 @@
+module Re = Core
+
+exception Parse_error = Perl.Parse_error
+exception Not_supported = Perl.Not_supported
+
+type regexp = Re.re
+
+type flag =
+  [ `CASELESS
+  | `MULTILINE
+  | `ANCHORED
+  | `DOTALL
+  ]
+
+type split_result =
+  | Text of string
+  | Delim of string
+  | Group of int * string
+  | NoGroup
+
+type groups = Core.Group.t
+
+let re ?(flags = []) pat =
+  let opts =
+    List.map
+      (function
+        | `CASELESS -> `Caseless
+        | `MULTILINE -> `Multiline
+        | `ANCHORED -> `Anchored
+        | `DOTALL -> `Dotall)
+      flags
+  in
+  Perl.re ~opts pat
+;;
+
+let re_result ?flags s =
+  match re ?flags s with
+  | s -> Ok s
+  | exception Not_supported -> Error `Not_supported
+  | exception Parse_error -> Error `Parse_error
+;;
+
+let regexp ?flags pat = Re.compile (re ?flags pat)
+let extract ~rex s = Re.Group.all (Re.exec rex s)
+let exec ~rex ?pos s = Re.exec rex ?pos s
+let names rex = Re.group_names rex |> List.map fst |> Array.of_list
+
+let get_named_substring_opt rex name s =
+  let rec loop = function
+    | [] -> None
+    | (n, i) :: rem when n = name ->
+      (match Re.Group.get_opt s i with
+       | None -> loop rem
+       | Some _ as s -> s)
+    | _ :: rem -> loop rem
+  in
+  loop (Re.group_names rex)
+;;
+
+let get_substring_ofs s i = Re.Group.offset s i
+let pmatch ~rex s = Re.execp rex s
+
+let substitute ~rex ~subst str =
+  let b = Buffer.create 1024 in
+  let rec loop pos on_match =
+    if Re.execp ~pos rex str
+    then (
+      let ss = Re.exec ~pos rex str in
+      let start, fin = Re.Group.offset ss 0 in
+      if on_match && start = pos && start = fin
+      then (
+        if (* Empty match following a match *)
+           pos < String.length str
+        then (
+          Buffer.add_char b str.[pos];
+          loop (pos + 1) false))
+      else (
+        let pat = Re.Group.get ss 0 in
+        Buffer.add_substring b str pos (start - pos);
+        Buffer.add_string b (subst pat);
+        if start = fin
+        then (
+          if (* Manually advance by one after an empty match *)
+             fin < String.length str
+          then (
+            Buffer.add_char b str.[fin];
+            loop (fin + 1) false))
+        else loop fin true))
+    else Buffer.add_substring b str pos (String.length str - pos)
+  in
+  loop 0 false;
+  Buffer.contents b
+;;
+
+let split ~rex s =
+  let rec split accu start =
+    if start = String.length s
+    then accu
+    else (
+      match
+        let g = Re.exec rex s ~pos:start in
+        if Group.stop g 0 = start then Re.exec rex s ~pos:(start + 1) else g
+      with
+      | exception Not_found -> String.sub s start (String.length s - start) :: accu
+      | g ->
+        let next = Group.stop g 0 in
+        split (String.sub s start (Group.start g 0 - start) :: accu) next)
+  in
+  match Re.exec rex s ~pos:0 with
+  | g ->
+    List.rev
+      (if Group.start g 0 = 0
+       then split [] (Group.stop g 0)
+       else split [ String.sub s 0 (Group.start g 0) ] (Group.stop g 0))
+  | exception Not_found -> if s = "" then [] else [ s ]
+;;
+
+(* From PCRE *)
+let string_unsafe_sub s ofs len =
+  let r = Bytes.create len in
+  Bytes.unsafe_blit s ofs r 0 len;
+  Bytes.unsafe_to_string r
+;;
+
+let quote s =
+  let len = String.length s in
+  let buf = Bytes.create (len lsl 1) in
+  let pos = ref 0 in
+  for i = 0 to len - 1 do
+    match String.unsafe_get s i with
+    | ('\\' | '^' | '$' | '.' | '[' | '|' | '(' | ')' | '?' | '*' | '+' | '{') as c ->
+      Bytes.unsafe_set buf !pos '\\';
+      incr pos;
+      Bytes.unsafe_set buf !pos c;
+      incr pos
+    | c ->
+      Bytes.unsafe_set buf !pos c;
+      incr pos
+  done;
+  string_unsafe_sub buf 0 !pos
+;;
+
+let full_split ?(max = 0) ~rex s =
+  if String.length s = 0
+  then []
+  else if max = 1
+  then [ Text s ]
+  else (
+    let results = Re.split_full rex s in
+    let matches =
+      List.map
+        (function
+          | `Text s -> [ Text s ]
+          | `Delim d ->
+            let matches = Re.Group.all_offset d in
+            let delim = Re.Group.get d 0 in
+            Delim delim
+            ::
+            (let l = ref [] in
+             for i = 1 to Array.length matches - 1 do
+               l
+               := (if matches.(i) = (-1, -1) then NoGroup else Group (i, Re.Group.get d i))
+                  :: !l
+             done;
+             List.rev !l))
+        results
+    in
+    List.concat matches)
+;;
+
+type substrings = Group.t
+
+let get_substring s i = Re.Group.get s i
+
+let get_named_substring rex name s =
+  match get_named_substring_opt rex name s with
+  | None -> raise Not_found
+  | Some s -> s
+;;

unikernel/duniverse/ocaml-re/lib/pcre.mli

@@ -0,0 +1,67 @@
+(** NOTE: Only a subset of the PCRE spec is supported *)
+
+exception Parse_error
+exception Not_supported
+
+type regexp = Core.re
+
+type flag =
+  [ `CASELESS
+  | `MULTILINE
+  | `ANCHORED
+  | `DOTALL
+  ]
+
+type groups = Core.Group.t
+
+(** Result of a {!Pcre.full_split} *)
+type split_result =
+  | Text of string (** Text part of splitted string *)
+  | Delim of string (** Delimiter part of splitted string *)
+  | Group of int * string (** Subgroup of matched delimiter (subgroup_nr, subgroup_str) *)
+  | NoGroup (** Unmatched subgroup *)
+
+(** [re ~flags s] creates the regexp [s] using the pcre syntax. *)
+val re : ?flags:flag list -> string -> Core.t
+
+val re_result
+  :  ?flags:flag list
+  -> string
+  -> (Core.t, [ `Not_supported | `Parse_error ]) result
+
+(** [re ~flags s] compiles the regexp [s] using the pcre syntax. *)
+val regexp : ?flags:flag list -> string -> regexp
+
+(** [extract ~rex s] executes [rex] on [s] and returns the matching groups. *)
+val extract : rex:regexp -> string -> string array
+
+(** Equivalent to {!Core.exec}. *)
+val exec : rex:regexp -> ?pos:int -> string -> groups
+
+(** Equivalent to {!Core.Group.get}. *)
+val get_substring : groups -> int -> string
+
+(** Return the names of named groups. *)
+val names : regexp -> string array
+
+(** Return the first matched named group, or raise [Not_found]. Prefer to use
+    the non-raising version [get_named_substring_opt] *)
+val get_named_substring : regexp -> string -> groups -> string
+
+(** Return the first matched named group, or raise [Not_found]. *)
+val get_named_substring_opt : regexp -> string -> groups -> string option
+
+(** Equivalent to {!Core.Group.offset}. *)
+val get_substring_ofs : groups -> int -> int * int
+
+(** Equivalent to {!Core.execp}. *)
+val pmatch : rex:regexp -> string -> bool
+
+val substitute : rex:Core.re -> subst:(string -> string) -> string -> string
+val full_split : ?max:int -> rex:regexp -> string -> split_result list
+val split : rex:regexp -> string -> string list
+val quote : string -> string
+
+(** {2 Deprecated} *)
+
+type substrings = Group.t

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

@@ -0,0 +1,360 @@
+(*
+   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 = Parse_buffer.Parse_error
+exception Not_supported
+
+let acc_digits =
+  let rec loop base digits acc i =
+    match digits with
+    | [] -> acc
+    | d :: digits ->
+      let acc = acc + (d * i) in
+      let i = i * i in
+      loop base digits acc i
+  in
+  fun ~base ~digits -> loop base digits 0 1
+;;
+
+let char_of_int x =
+  match char_of_int x with
+  | x -> x
+  | exception _ -> raise Parse_error
+;;
+
+type elem =
+  | Char of char
+  | Set of Ast.t
+
+let char_b = Char '\008'
+let char_newline = Char '\n'
+let char_cr = Char '\r'
+let char_tab = Char '\t'
+let word_char = [ Re.alnum; Re.char '_' ]
+let word = Set (Re.alt word_char)
+let not_word = Set (Re.alt word_char)
+let space = Set Re.space
+let not_space = Set (Re.compl [ Re.space ])
+let digit = Set Re.digit
+let not_digit = Set (Re.compl [ Re.digit ])
+
+let parse ~multiline ~dollar_endonly ~dotall ~ungreedy s =
+  let buf = Parse_buffer.create s in
+  let accept = Parse_buffer.accept buf in
+  let eos () = Parse_buffer.eos buf in
+  let test c = Parse_buffer.test buf c in
+  let unget () = Parse_buffer.unget buf in
+  let get () = Parse_buffer.get buf in
+  let greedy_mod r =
+    let gr = accept '?' in
+    let gr = if ungreedy then not gr else gr in
+    if gr then Re.non_greedy r else Re.greedy r
+  in
+  let rec regexp () = regexp' [ branch () ]
+  and regexp' left =
+    if accept '|' then regexp' (branch () :: left) else Re.alt (List.rev left)
+  and branch () = branch' []
+  and branch' left =
+    if eos () || test '|' || test ')'
+    then Re.seq (List.rev left)
+    else branch' (piece () :: left)
+  and in_brace ~f ~init =
+    match accept '{' with
+    | false -> None
+    | true ->
+      let rec loop acc =
+        if accept '}'
+        then acc
+        else (
+          let acc = f acc in
+          loop acc)
+      in
+      Some (loop init)
+  and piece () =
+    let r = atom () in
+    if accept '*'
+    then greedy_mod (Re.rep r)
+    else if accept '+'
+    then greedy_mod (Re.rep1 r)
+    else if accept '?'
+    then greedy_mod (Re.opt r)
+    else if accept '{'
+    then (
+      match Parse_buffer.integer buf with
+      | Some i ->
+        let j = if accept ',' then Parse_buffer.integer buf else Some i in
+        if not (accept '}') then raise Parse_error;
+        (match j with
+         | Some j when j < i -> raise Parse_error
+         | _ -> ());
+        greedy_mod (Re.repn r i j)
+      | None ->
+        unget ();
+        r)
+    else r
+  and atom () =
+    if accept '.'
+    then if dotall then Re.any else Re.notnl
+    else if accept '('
+    then
+      if accept '?'
+      then
+        if accept ':'
+        then (
+          let r = regexp () in
+          if not (accept ')') then raise Parse_error;
+          r)
+        else if accept '#'
+        then comment ()
+        else if accept '<'
+        then (
+          let name = name () in
+          let r = regexp () in
+          if not (accept ')') then raise Parse_error;
+          Re.group ~name r)
+        else raise Parse_error
+      else (
+        let r = regexp () in
+        if not (accept ')') then raise Parse_error;
+        Re.group r)
+    else if accept '^'
+    then if multiline then Re.bol else Re.bos
+    else if accept '$'
+    then if multiline then Re.eol else if dollar_endonly then Re.leol else Re.eos
+    else if accept '['
+    then if accept '^' then Re.compl (bracket []) else Re.alt (bracket [])
+    else if accept '\\'
+    then (
+      (* XXX
+         - Back-references
+         - \cx (control-x), \ddd
+      *)
+      if eos () then raise Parse_error;
+      match get () with
+      | 'w' -> Re.alt [ Re.alnum; Re.char '_' ]
+      | 'W' -> Re.compl [ Re.alnum; Re.char '_' ]
+      | 's' -> Re.space
+      | 'S' -> Re.compl [ Re.space ]
+      | 'd' -> Re.digit
+      | 'D' -> Re.compl [ Re.digit ]
+      | 'b' -> Re.alt [ Re.bow; Re.eow ]
+      | 'B' -> Re.not_boundary
+      | 'A' -> Re.bos
+      | 'Z' -> Re.leol
+      | 'z' -> Re.eos
+      | 'G' -> Re.start
+      | 'e' -> Re.char '\x1b'
+      | 'f' -> Re.char '\x0c'
+      | 'n' -> Re.char '\n'
+      | 'r' -> Re.char '\r'
+      | 't' -> Re.char '\t'
+      | 'Q' -> quote (Buffer.create 12)
+      | 'E' -> raise Parse_error
+      | 'x' ->
+        let c1, c2 =
+          match in_brace ~init:[] ~f:(fun acc -> hexdigit () :: acc) with
+          | Some [ c1; c2 ] -> c1, c2
+          | Some [ c2 ] -> 0, c2
+          | Some _ -> raise Parse_error
+          | None ->
+            let c1 = hexdigit () in
+            let c2 = hexdigit () in
+            c1, c2
+        in
+        let code = (c1 * 16) + c2 in
+        Re.char (char_of_int code)
+      | 'o' ->
+        (match
+           in_brace ~init:[] ~f:(fun acc ->
+             match maybe_octaldigit () with
+             | None -> raise Parse_error
+             | Some p -> p :: acc)
+         with
+         | None -> raise Parse_error
+         | Some digits -> Re.char (char_of_int (acc_digits ~base:8 ~digits)))
+      | 'a' .. 'z' | 'A' .. 'Z' -> raise Parse_error
+      | '0' .. '7' as n1 ->
+        let n2 = maybe_octaldigit () in
+        let n3 = maybe_octaldigit () in
+        (match n2, n3 with
+         | Some n2, Some n3 ->
+           let n1 = Char.code n1 - Char.code '0' in
+           Re.char (char_of_int ((n1 * (8 * 8)) + (n2 * 8) + n3))
+         | _, _ -> raise Not_supported)
+      | '8' .. '9' -> raise Not_supported
+      | c -> Re.char c)
+    else (
+      if eos () then raise Parse_error;
+      match get () with
+      | '*' | '+' | '?' | '{' | '\\' -> raise Parse_error
+      | c -> Re.char c)
+  and quote buf =
+    if accept '\\'
+    then (
+      if eos () then raise Parse_error;
+      match get () with
+      | 'E' -> Re.str (Buffer.contents buf)
+      | c ->
+        Buffer.add_char buf '\\';
+        Buffer.add_char buf c;
+        quote buf)
+    else (
+      if eos () then raise Parse_error;
+      Buffer.add_char buf (get ());
+      quote buf)
+  and hexdigit () =
+    if eos () then raise Parse_error;
+    match get () with
+    | '0' .. '9' as d -> Char.code d - Char.code '0'
+    | 'a' .. 'f' as d -> Char.code d - Char.code 'a' + 10
+    | 'A' .. 'F' as d -> Char.code d - Char.code 'A' + 10
+    | _ -> raise Parse_error
+  and maybe_octaldigit () =
+    if eos ()
+    then None
+    else (
+      match get () with
+      | '0' .. '7' as d -> Some (Char.code d - Char.code '0')
+      | _ -> None)
+  and name () =
+    if eos ()
+    then raise Parse_error
+    else (
+      match get () with
+      | ('_' | 'a' .. 'z' | 'A' .. 'Z') as c ->
+        let b = Buffer.create 32 in
+        Buffer.add_char b c;
+        name' b
+      | _ -> raise Parse_error)
+  and name' b =
+    if eos ()
+    then raise Parse_error
+    else (
+      match get () with
+      | ('_' | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9') as c ->
+        Buffer.add_char b c;
+        name' b
+      | '>' -> Buffer.contents b
+      | _ -> raise Parse_error)
+  and bracket s =
+    if s <> [] && accept ']'
+    then s
+    else (
+      match char () with
+      | Set st -> bracket (st :: s)
+      | Char c ->
+        if accept '-'
+        then
+          if accept ']'
+          then Re.char c :: Re.char '-' :: s
+          else
+            bracket
+              (match char () with
+               | Char c' -> Re.rg c c' :: s
+               | Set st' -> Re.char c :: Re.char '-' :: st' :: s)
+        else bracket (Re.char c :: s))
+  and char () =
+    if eos () then raise Parse_error;
+    let c = get () in
+    if c = '['
+    then (
+      if accept '=' then raise Not_supported;
+      match Posix_class.parse buf with
+      | Some set -> Set set
+      | None ->
+        if accept '.'
+        then (
+          if eos () then raise Parse_error;
+          let c = get () in
+          if not (accept '.') then raise Not_supported;
+          if not (accept ']') then raise Parse_error;
+          Char c)
+        else Char c)
+    else if c = '\\'
+    then (
+      if eos () then raise Parse_error;
+      let c = get () in
+      (* XXX
+         \127, ...
+      *)
+      match c with
+      | 'b' -> char_b
+      | 'n' -> char_newline (*XXX*)
+      | 'r' -> char_cr (*XXX*)
+      | 't' -> char_tab (*XXX*)
+      | 'w' -> word
+      | 'W' -> not_word
+      | 's' -> space
+      | 'S' -> not_space
+      | 'd' -> digit
+      | 'D' -> not_digit
+      | 'a' .. 'z' | 'A' .. 'Z' -> raise Parse_error
+      | '0' .. '9' -> raise Not_supported
+      | _ -> Char c)
+    else Char c
+  and comment () =
+    if eos () then raise Parse_error;
+    if accept ')'
+    then Re.epsilon
+    else (
+      Parse_buffer.junk buf;
+      comment ())
+  in
+  let res = regexp () in
+  if not (eos ()) then raise Parse_error;
+  res
+;;
+
+type opt =
+  [ `Ungreedy
+  | `Dotall
+  | `Dollar_endonly
+  | `Multiline
+  | `Anchored
+  | `Caseless
+  ]
+
+let re ?(opts = []) s =
+  let r =
+    parse
+      ~multiline:(List.memq `Multiline opts)
+      ~dollar_endonly:(List.memq `Dollar_endonly opts)
+      ~dotall:(List.memq `Dotall opts)
+      ~ungreedy:(List.memq `Ungreedy opts)
+      s
+  in
+  let r = if List.memq `Anchored opts then Re.seq [ Re.start; r ] else r in
+  let r = if List.memq `Caseless opts then Re.no_case r else r in
+  r
+;;
+
+let compile = Re.compile
+let compile_pat ?(opts = []) s = compile (re ~opts s)
+
+let re_result ?opts s =
+  match re ?opts s with
+  | s -> Ok s
+  | exception Not_supported -> Error `Not_supported
+  | exception Parse_error -> Error `Parse_error
+;;

unikernel/duniverse/ocaml-re/lib/perl.mli

@@ -0,0 +1,51 @@
+(*
+   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
+*)
+
+(** Perl-style regular expressions *)
+
+exception Parse_error
+
+(** Errors that can be raised during the parsing of the regular expression *)
+exception Not_supported
+
+type opt =
+  [ `Ungreedy
+  | `Dotall
+  | `Dollar_endonly
+  | `Multiline
+  | `Anchored
+  | `Caseless
+  ]
+
+(** Parsing of a Perl-style regular expression *)
+val re : ?opts:opt list -> string -> Core.t
+
+val re_result
+  :  ?opts:opt list
+  -> string
+  -> (Core.t, [ `Not_supported | `Parse_error ]) result
+
+(** (Same as [Re.compile]) *)
+val compile : Core.t -> Core.re
+
+(** Regular expression compilation *)
+val compile_pat : ?opts:opt list -> string -> Core.re

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

@@ -0,0 +1,24 @@
+module Pmark = struct
+  type t = int
+
+  let equal (x : int) (y : int) = x = y
+  let compare (x : int) (y : int) = compare x y
+  let r = Atomic.make 1
+  let gen () = Atomic.fetch_and_add r 1
+  let pp = Format.pp_print_int
+end
+
+include Pmark
+
+module Set = struct
+  module Set = Set.Make (Pmark)
+
+  let[@warning "-32"] to_list x =
+    let open Set in
+    to_seq x |> List.of_seq
+  ;;
+
+  include Set
+end
+
+let to_dyn = Dyn.int

unikernel/duniverse/ocaml-re/lib/pmark.mli

@@ -0,0 +1,13 @@
+type t = private int
+
+val equal : t -> t -> bool
+val compare : t -> t -> int
+val gen : unit -> t
+val pp : t Fmt.t
+val to_dyn : t -> Dyn.t
+
+module Set : sig
+  include Set.S with type elt = t
+
+  val to_list : t -> elt list
+end

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

@@ -0,0 +1,163 @@
+(*
+   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
+*)
+
+(*
+   What we could (should?) do:
+   - a* ==> longest ((shortest (no_group a)* ), a | ())  (!!!)
+   - abc understood as (ab)c
+   - "((a?)|b)" against "ab" should not bind the first subpattern to anything
+
+   Note that it should be possible to handle "(((ab)c)d)e" efficiently
+*)
+module Re = Core
+
+exception Parse_error = Parse_buffer.Parse_error
+exception Not_supported
+
+let parse newline s =
+  let buf = Parse_buffer.create s in
+  let accept = Parse_buffer.accept buf in
+  let eos () = Parse_buffer.eos buf in
+  let test c = Parse_buffer.test buf c in
+  let unget () = Parse_buffer.unget buf in
+  let get () = Parse_buffer.get buf in
+  let rec regexp () = regexp' [ branch () ]
+  and regexp' left =
+    if accept '|' then regexp' (branch () :: left) else Re.alt (List.rev left)
+  and branch () = branch' []
+  and branch' left =
+    if eos () || test '|' || test ')'
+    then Re.seq (List.rev left)
+    else branch' (piece () :: left)
+  and piece () =
+    let r = atom () in
+    if accept '*'
+    then Re.rep (Re.nest r)
+    else if accept '+'
+    then Re.rep1 (Re.nest r)
+    else if accept '?'
+    then Re.opt r
+    else if accept '{'
+    then (
+      match Parse_buffer.integer buf with
+      | Some i ->
+        let j = if accept ',' then Parse_buffer.integer buf else Some i in
+        if not (accept '}') then raise Parse_error;
+        (match j with
+         | Some j when j < i -> raise Parse_error
+         | _ -> ());
+        Re.repn (Re.nest r) i j
+      | None ->
+        unget ();
+        r)
+    else r
+  and atom () =
+    if accept '.'
+    then if newline then Re.notnl else Re.any
+    else if accept '('
+    then (
+      let r = regexp () in
+      if not (accept ')') then raise Parse_error;
+      Re.group r)
+    else if accept '^'
+    then if newline then Re.bol else Re.bos
+    else if accept '$'
+    then if newline then Re.eol else Re.eos
+    else if accept '['
+    then
+      if accept '^'
+      then Re.diff (Re.compl (bracket [])) (Re.char '\n')
+      else Re.alt (bracket [])
+    else if accept '\\'
+    then (
+      if eos () then raise Parse_error;
+      match get () with
+      | ('|' | '(' | ')' | '*' | '+' | '?' | '[' | '.' | '^' | '$' | '{' | '\\') as c ->
+        Re.char c
+      | _ -> raise Parse_error)
+    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 (
+      match char () with
+      | `Set st -> bracket (st :: s)
+      | `Char c ->
+        if accept '-'
+        then
+          if accept ']'
+          then Re.char c :: Re.char '-' :: s
+          else
+            bracket
+              (match char () with
+               | `Char c' -> Re.rg c c' :: s
+               | `Set st' -> Re.char c :: Re.char '-' :: st' :: s)
+        else bracket (Re.char c :: s))
+  and char () =
+    if eos () then raise Parse_error;
+    let c = get () in
+    if c = '['
+    then (
+      match Posix_class.parse buf with
+      | Some set -> `Set set
+      | None ->
+        if accept '.'
+        then (
+          if eos () then raise Parse_error;
+          let c = get () in
+          if not (accept '.') then raise Not_supported;
+          if not (accept ']') then raise Parse_error;
+          `Char c)
+        else `Char c)
+    else `Char c
+  in
+  let res = regexp () in
+  if not (eos ()) then raise Parse_error;
+  res
+;;
+
+type opt =
+  [ `ICase
+  | `NoSub
+  | `Newline
+  ]
+
+let re ?(opts = []) s =
+  let r = parse (List.memq `Newline opts) s in
+  let r = if List.memq `ICase opts then Re.no_case r else r in
+  let r = if List.memq `NoSub opts then Re.no_group r else r in
+  r
+;;
+
+let re_result ?opts s =
+  match re ?opts s with
+  | s -> Ok s
+  | exception Not_supported -> Error `Not_supported
+  | exception Parse_error -> Error `Parse_error
+;;
+
+let compile re = Re.compile (Re.longest re)
+let compile_pat ?(opts = []) s = compile (re ~opts s)

unikernel/duniverse/ocaml-re/lib/posix.mli

@@ -0,0 +1,107 @@
+(*
+   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
+*)
+
+(** References:
+    - {{:http://www.opengroup.org/onlinepubs/007908799/xbd/re.html} re}
+    - {{:http://www.opengroup.org/onlinepubs/007908799/xsh/regcomp.html} regcomp}
+
+    Example of how to use this module (to parse some IRC logs):
+
+    {[
+      type msg =
+        { time : string
+        ; author : string
+        ; content : string
+        }
+
+      let re = Core.compile (Re_posix.re "([^:].*:[^:]*:[^:]{2})<.([^>]+)> (.+)$")
+
+      (* parse a line *)
+      let match_line line =
+        try
+          let substrings = Core.exec re line in
+          let groups = Core.get_all substrings in
+          (* groups can be obtained directly by index within [substrings] *)
+          Some { time = groups.(1); author = groups.(2); content = groups.(3) }
+        with
+        | Not_found -> None (* regex didn't match *)
+      ;;
+    ]} *)
+
+(* XXX Character classes *)
+
+exception Parse_error
+
+(** Errors that can be raised during the parsing of the regular expression *)
+exception Not_supported
+
+type opt =
+  [ `ICase
+  | `NoSub
+  | `Newline
+  ]
+
+(** Parsing of a Posix extended regular expression *)
+val re : ?opts:opt list -> string -> Core.t
+
+val re_result
+  :  ?opts:opt list
+  -> string
+  -> (Core.t, [ `Not_supported | `Parse_error ]) result
+
+(** [compile r] is defined as [Core.compile (Core.longest r)] *)
+val compile : Core.t -> Core.re
+
+(** [compile_pat ?opts regex] compiles the Posix extended regular expression [regexp] *)
+val compile_pat : ?opts:opt list -> string -> Core.re
+
+(*
+   Deviation from the standard / ambiguities in the standard
+   ---------------------------------------------------------
+   We tested the behavior of the Linux library (glibc) and the Solaris
+   library.
+
+   (1) An expression [efg] should be parsed as [(ef)g].
+   All implementations parse it as [e(fg)].
+   (2) When matching the pattern "((a)|b)*" against the string "ab",
+   the sub-expression "((a)|b)" should match "b", and the
+   sub-expression "(a)" should not match anything.
+   In both implementation, the sub-expression "(a)" matches "a".
+   (3) When matching the pattern "(aa?)*" against the string "aaa", it is
+   not clear whether the final match of the sub-expression "(aa?)"  is
+   the last "a" (all matches of the sub-expression are successively
+   maximized), or "aa" (the final match is maximized).
+   Both implementations implements the first case.
+   (4) When matching the pattern "((a?)|b)*" against the string "ab",
+   the sub-expression "((a?)|b)" should match the empty string at the
+   end of the string (it is better to match the empty string than to
+   match nothing).
+   In both implementations, this sub-expression matches "b".
+   (Strangely, in the Linux implementation, the sub-expression "(a?)"
+   correctly matches the empty string at the end of the string)
+
+   This library behaves the same way as the other libraries for all
+   points, except for (2) and (4) where it follows the standard.
+
+   The behavior of this library in theses four cases may change in future
+   releases.
+*)

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

@@ -0,0 +1,53 @@
+module Re = Core
+
+let of_name = function
+  | "alpha" -> Re.alpha
+  | "alnum" -> Re.alnum
+  | "ascii" -> Re.ascii
+  | "blank" -> Re.blank
+  | "cntrl" -> Re.cntrl
+  | "digit" -> Re.digit
+  | "lower" -> Re.lower
+  | "print" -> Re.print
+  | "space" -> Re.space
+  | "upper" -> Re.upper
+  | "word" -> Re.wordc
+  | "punct" -> Re.punct
+  | "graph" -> Re.graph
+  | "xdigit" -> Re.xdigit
+  | class_ -> invalid_arg ("Invalid pcre class: " ^ class_)
+;;
+
+let names =
+  [ "alpha"
+  ; "alnum"
+  ; "ascii"
+  ; "blank"
+  ; "cntrl"
+  ; "digit"
+  ; "lower"
+  ; "print"
+  ; "space"
+  ; "upper"
+  ; "word"
+  ; "punct"
+  ; "graph"
+  ; "xdigit"
+  ]
+;;
+
+let parse buf =
+  let accept = Parse_buffer.accept buf in
+  let accept_s = Parse_buffer.accept_s buf in
+  match accept ':' with
+  | false -> None
+  | true ->
+    let compl = accept '^' in
+    let cls =
+      try List.find accept_s names with
+      | Not_found -> raise Parse_buffer.Parse_error
+    in
+    if not (accept_s ":]") then raise Parse_buffer.Parse_error;
+    let posix_class = of_name cls in
+    Some (if compl then Re.compl [ posix_class ] else posix_class)
+;;

unikernel/duniverse/ocaml-re/lib/posix_class.mli

@@ -0,0 +1,3 @@
+val names : string list
+val of_name : string -> Core.t
+val parse : Parse_buffer.t -> Core.t option

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

@@ -0,0 +1,9 @@
+include Core
+include Replace
+module View = View
+module Emacs = Emacs
+module Glob = Glob
+module Perl = Perl
+module Pcre = Pcre
+module Posix = Posix
+module Str = Str

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

@@ -0,0 +1,53 @@
+let replace ?(pos = 0) ?len ?(all = true) re ~f s =
+  if pos < 0 then invalid_arg "Re.replace";
+  let limit =
+    match len with
+    | None -> String.length s
+    | Some l ->
+      if l < 0 || pos + l > String.length s then invalid_arg "Re.replace";
+      pos + l
+  in
+  (* buffer into which we write the result *)
+  let buf = Buffer.create (String.length s) in
+  (* iterate on matched substrings. *)
+  let rec iter pos on_match =
+    if pos <= limit
+    then (
+      match
+        Compile.match_str ~groups:true ~partial:false re s ~pos ~len:(limit - pos)
+      with
+      | Match substr ->
+        let p1 = Group.start_offset substr 0 |> Group.Offset.get_no_check in
+        let p2 = Group.stop_offset substr 0 |> Group.Offset.get_no_check in
+        if pos = p1 && p1 = p2 && on_match
+        then (
+          (* if we matched an empty string right after a match,
+             we must manually advance by 1 *)
+          if p2 < limit then Buffer.add_char buf s.[p2];
+          iter (p2 + 1) false)
+        else (
+          (* add string between previous match and current match *)
+          Buffer.add_substring buf s pos (p1 - pos);
+          (* what should we replace the matched group with? *)
+          let replacing = f substr in
+          Buffer.add_string buf replacing;
+          if all
+          then
+            (* if we matched an empty string, we must manually advance by 1 *)
+            iter
+              (if p1 = p2
+               then (
+                 (* a non char could be past the end of string. e.g. $ *)
+                 if p2 < limit then Buffer.add_char buf s.[p2];
+                 p2 + 1)
+               else p2)
+              (p1 <> p2)
+          else Buffer.add_substring buf s p2 (limit - p2))
+      | Running _ -> ()
+      | Failed -> Buffer.add_substring buf s pos (limit - pos))
+  in
+  iter pos false;
+  Buffer.contents buf
+;;
+
+let replace_string ?pos ?len ?all re ~by s = replace ?pos ?len ?all re s ~f:(fun _ -> by)

unikernel/duniverse/ocaml-re/lib/replace.mli

@@ -0,0 +1,35 @@
+(** [replace ~all re ~f s] iterates on [s], and replaces every occurrence
+    of [re] with [f substring] where [substring] is the current match.
+    If [all = false], then only the first occurrence of [re] is replaced. *)
+val replace
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int
+  -> ?all:bool (** Default: true. Otherwise only replace first occurrence *)
+  -> Compile.re (** matched groups *)
+  -> f:(Group.t -> string) (** how to replace *)
+  -> string (** string to replace in *)
+  -> string
+
+(** [replace_string ~all re ~by s] iterates on [s], and replaces every
+    occurrence of [re] with [by]. If [all = false], then only the first
+    occurrence of [re] is replaced.
+
+    {5 Examples:}
+    {[
+      # let regex = Re.compile (Re.char ',');;
+      val regex : re = <abstr>
+
+      # Re.replace_string regex ~by:";" "[1,2,3,4,5,6,7]";;
+      - : string = "[1;2;3;4;5;6;7]"
+
+      # Re.replace_string regex ~all:false ~by:";" "[1,2,3,4,5,6,7]";;
+      - : string = "[1;2,3,4,5,6,7]"
+    ]} *)
+val replace_string
+  :  ?pos:int (** Default: 0 *)
+  -> ?len:int
+  -> ?all:bool (** Default: true. Otherwise only replace first occurrence *)
+  -> Compile.re (** matched groups *)
+  -> by:string (** replacement string *)
+  -> string (** string to replace in *)
+  -> string

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

@@ -0,0 +1,114 @@
+let all ?(pos = 0) ?len re s : _ Seq.t =
+  if pos < 0 then invalid_arg "Re.all";
+  (* index of the first position we do not consider.
+     !pos < limit is an invariant *)
+  let limit =
+    match len with
+    | None -> String.length s
+    | Some l ->
+      if l < 0 || pos + l > String.length s then invalid_arg "Re.all";
+      pos + l
+  in
+  (* iterate on matches. When a match is found, search for the next
+     one just after its end *)
+  let rec aux pos on_match () =
+    if pos > limit
+    then Seq.Nil (* no more matches *)
+    else (
+      match
+        Compile.match_str ~groups:true ~partial:false re s ~pos ~len:(limit - pos)
+      with
+      | Match substr ->
+        let p1 = Group.start_offset substr 0 |> Group.Offset.get_no_check in
+        let p2 = Group.stop_offset substr 0 |> Group.Offset.get_no_check in
+        if on_match && p1 = pos && p1 = p2
+        then (* skip empty match right after a match *)
+          aux (pos + 1) false ()
+        else (
+          let pos = if p1 = p2 then p2 + 1 else p2 in
+          Seq.Cons (substr, aux pos (p1 <> p2)))
+      | Running _ | Failed -> Seq.Nil)
+  in
+  aux pos false
+;;
+
+let matches ?pos ?len re s : _ Seq.t =
+  all ?pos ?len re s |> Seq.map (fun sub -> Group.get sub 0)
+;;
+
+let split_full ?(pos = 0) ?len re s : _ Seq.t =
+  if pos < 0 then invalid_arg "Re.split";
+  let limit =
+    match len with
+    | None -> String.length s
+    | Some l ->
+      if l < 0 || pos + l > String.length s then invalid_arg "Re.split";
+      pos + l
+  in
+  (* i: start of delimited string
+     pos: first position after last match of [re]
+     limit: first index we ignore (!pos < limit is an invariant) *)
+  let pos0 = pos in
+  let rec aux state i pos () =
+    match state with
+    | `Idle when pos > limit ->
+      (* We had an empty match at the end of the string *)
+      assert (i = limit);
+      Seq.Nil
+    | `Idle ->
+      (match
+         Compile.match_str ~groups:true ~partial:false re s ~pos ~len:(limit - pos)
+       with
+       | Match substr ->
+         let p1 = Group.start_offset substr 0 |> Group.Offset.get_no_check in
+         let p2 = Group.stop_offset substr 0 |> Group.Offset.get_no_check in
+         let pos = if p1 = p2 then p2 + 1 else p2 in
+         let old_i = i in
+         let i = p2 in
+         if old_i = p1 && p1 = p2 && p1 > pos0
+         then (* Skip empty match right after a delimiter *)
+           aux state i pos ()
+         else if p1 > pos0
+         then (
+           (* string does not start by a delimiter *)
+           let text = String.sub s old_i (p1 - old_i) in
+           let state = `Yield (`Delim substr) in
+           Seq.Cons (`Text text, aux state i pos))
+         else Seq.Cons (`Delim substr, aux state i pos)
+       | Running _ -> Seq.Nil
+       | Failed ->
+         if i < limit
+         then (
+           let text = String.sub s i (limit - i) in
+           (* yield last string *)
+           Seq.Cons (`Text text, aux state limit pos))
+         else Seq.Nil)
+    | `Yield x -> Seq.Cons (x, aux `Idle i pos)
+  in
+  aux `Idle pos pos
+;;
+
+let split ?pos ?len re s : _ Seq.t =
+  let seq = split_full ?pos ?len re s in
+  let rec filter seq () =
+    match seq () with
+    | Seq.Nil -> Seq.Nil
+    | Seq.Cons (`Delim _, tl) -> filter tl ()
+    | Seq.Cons (`Text s, tl) -> Seq.Cons (s, filter tl)
+  in
+  filter seq
+;;
+
+let split_delim ?pos ?len re s : _ Seq.t =
+  let seq = split_full ?pos ?len re s in
+  let rec filter ~delim seq () =
+    match seq () with
+    | Seq.Nil -> if delim then Seq.Cons ("", fun () -> Seq.Nil) else Seq.Nil
+    | Seq.Cons (`Delim _, tl) ->
+      if delim
+      then Seq.Cons ("", fun () -> filter ~delim:true tl ())
+      else filter ~delim:true tl ()
+    | Seq.Cons (`Text s, tl) -> Seq.Cons (s, filter ~delim:false tl)
+  in
+  filter ~delim:true seq
+;;

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

@@ -0,0 +1,70 @@
+open Import
+
+type t =
+  { s : string
+  ; pos : int
+  ; len : int
+  }
+
+module L = struct
+  type nonrec t = t list
+
+  let get_substring slices ~start ~stop =
+    if stop = start
+    then ""
+    else (
+      let slices =
+        let rec drop slices remains =
+          if remains = 0
+          then slices
+          else (
+            match slices with
+            | [] -> assert false
+            | ({ s = _; pos; len } as slice) :: xs ->
+              let remains' = remains - len in
+              if remains' >= 0
+              then drop xs remains'
+              else (
+                let pos = pos + remains in
+                let len = len - remains in
+                { slice with pos; len } :: xs))
+        in
+        drop slices start
+      in
+      let buf = Buffer.create (stop - start) in
+      let rec take slices remains =
+        if remains > 0
+        then (
+          match slices with
+          | [] -> assert false
+          | { s; pos; len } :: xs ->
+            let remains' = remains - len in
+            if remains' > 0
+            then (
+              Buffer.add_substring buf s pos len;
+              take xs remains')
+            else Buffer.add_substring buf s pos remains)
+      in
+      take slices (stop - start);
+      Buffer.contents buf)
+  ;;
+
+  let rec drop t remains =
+    if remains = 0
+    then t
+    else (
+      match t with
+      | [] -> []
+      | ({ s = _; pos; len } as slice) :: t ->
+        if remains >= len
+        then drop t (remains - len)
+        else (
+          let delta = len - remains in
+          { slice with pos = pos + delta; len = len - delta } :: t))
+  ;;
+
+  let drop_rev t remains =
+    (* TODO Use a proper functional queue *)
+    if remains = 0 then t else List.rev (drop (List.rev t) remains)
+  ;;
+end

unikernel/duniverse/ocaml-re/lib/slice.mli

@@ -0,0 +1,12 @@
+type t =
+  { s : string
+  ; pos : int
+  ; len : int
+  }
+
+module L : sig
+  type nonrec t = t list
+
+  val get_substring : t -> start:int -> stop:int -> string
+  val drop_rev : t -> int -> t
+end

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

@@ -0,0 +1,299 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  linking exception.                                                 *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Modified by Jerome.Vouillon@pps.jussieu.fr for integration in RE *)
+
+(* $Id: re_str.ml,v 1.3 2002/07/03 15:47:54 vouillon Exp $ *)
+
+module Ast = Ast.Export
+
+include struct
+  open Core
+
+  let exec = exec
+  let exec_partial = exec_partial
+end
+
+type regexp =
+  { mtch : Compile.re Lazy.t
+  ; srch : Compile.re Lazy.t
+  }
+
+let compile_regexp s c =
+  let re = Emacs.re_no_emacs ~case:(not c) s in
+  { mtch = lazy (Compile.compile (Ast.seq [ Ast.start; re ]))
+  ; srch = lazy (Compile.compile re)
+  }
+;;
+
+let state = Domain.DLS.new_key (fun () -> None)
+
+let string_match re s p =
+  match exec ~pos:p (Lazy.force re.mtch) s with
+  | res ->
+    Domain.DLS.set state (Some res);
+    true
+  | exception Not_found ->
+    Domain.DLS.set state None;
+    false
+;;
+
+let string_partial_match re s p =
+  match exec_partial ~pos:p (Lazy.force re.mtch) s with
+  | `Full -> string_match re s p
+  | `Partial -> true
+  | `Mismatch -> false
+;;
+
+let search_forward re s p =
+  match exec ~pos:p (Lazy.force re.srch) s with
+  | res ->
+    Domain.DLS.set state (Some res);
+    fst (Group.offset res 0)
+  | exception Not_found ->
+    Domain.DLS.set state None;
+    raise Not_found
+;;
+
+let rec search_backward re s p =
+  match exec ~pos:p (Lazy.force re.mtch) s with
+  | res ->
+    Domain.DLS.set state (Some res);
+    p
+  | exception Not_found ->
+    Domain.DLS.set state None;
+    if p = 0 then raise Not_found else search_backward re s (p - 1)
+;;
+
+let valid_group n =
+  n >= 0
+  && n < 10
+  &&
+  match Domain.DLS.get state with
+  | None -> false
+  | Some m -> n < Group.nb_groups m
+;;
+
+let offset_group i =
+  match Domain.DLS.get state with
+  | Some m -> Group.offset m i
+  | None -> raise Not_found
+;;
+
+let group_len i =
+  match offset_group i with
+  | b, e -> e - b
+  | exception Not_found -> 0
+;;
+
+let rec repl_length repl p q len =
+  if p < len
+  then
+    if repl.[p] <> '\\'
+    then repl_length repl (p + 1) (q + 1) len
+    else (
+      let p = p + 1 in
+      if p = len then failwith "Str.replace: illegal backslash sequence";
+      let q =
+        match repl.[p] with
+        | '\\' -> q + 1
+        | '0' .. '9' as c -> q + group_len (Char.code c - Char.code '0')
+        | _ -> q + 2
+      in
+      repl_length repl (p + 1) q len)
+  else q
+;;
+
+let rec replace orig repl p res q len =
+  if p < len
+  then (
+    let c = repl.[p] in
+    if c <> '\\'
+    then (
+      Bytes.set res q c;
+      replace orig repl (p + 1) res (q + 1) len)
+    else (
+      match repl.[p + 1] with
+      | '\\' ->
+        Bytes.set res q '\\';
+        replace orig repl (p + 2) res (q + 1) len
+      | '0' .. '9' as c ->
+        let d =
+          let group = Char.code c - Char.code '0' in
+          match offset_group group with
+          | exception Not_found -> 0
+          | b, e ->
+            let d = e - b in
+            if d > 0 then String.blit orig b res q d;
+            d
+        in
+        replace orig repl (p + 2) res (q + d) len
+      | c ->
+        Bytes.set res q '\\';
+        Bytes.set res (q + 1) c;
+        replace orig repl (p + 2) res (q + 2) len))
+;;
+
+let replacement_text repl orig =
+  let len = String.length repl in
+  let res = Bytes.create (repl_length repl 0 0 len) in
+  replace orig repl 0 res 0 (String.length repl);
+  Bytes.unsafe_to_string res
+;;
+
+let quote s =
+  let len = String.length s in
+  let buf = Buffer.create (2 * len) in
+  for i = 0 to len - 1 do
+    match s.[i] with
+    | ('[' | ']' | '*' | '.' | '\\' | '?' | '+' | '^' | '$') as c ->
+      Buffer.add_char buf '\\';
+      Buffer.add_char buf c
+    | c -> Buffer.add_char buf c
+  done;
+  Buffer.contents buf
+;;
+
+let string_before s n = String.sub s 0 n
+let string_after s n = String.sub s n (String.length s - n)
+let first_chars s n = String.sub s 0 n
+let last_chars s n = String.sub s (String.length s - n) n
+let regexp e = compile_regexp e false
+let regexp_case_fold e = compile_regexp e true
+let regexp_string s = compile_regexp (quote s) false
+let regexp_string_case_fold s = compile_regexp (quote s) true
+
+let group_beginning n =
+  if not (valid_group n) then invalid_arg "Str.group_beginning";
+  let pos = fst (offset_group n) in
+  if pos = -1 then raise Not_found else pos
+;;
+
+let group_end n =
+  if not (valid_group n) then invalid_arg "Str.group_end";
+  let pos = snd (offset_group n) in
+  if pos = -1 then raise Not_found else pos
+;;
+
+let matched_group n txt =
+  let b, e = offset_group n in
+  String.sub txt b (e - b)
+;;
+
+let replace_matched repl matched = replacement_text repl matched
+
+let match_beginning () = group_beginning 0
+and match_end () = group_end 0
+and matched_string txt = matched_group 0 txt
+
+let substitute_first expr repl_fun text =
+  try
+    let pos = search_forward expr text 0 in
+    String.concat
+      ""
+      [ string_before text pos; repl_fun text; string_after text (match_end ()) ]
+  with
+  | Not_found -> text
+;;
+
+let global_substitute expr repl_fun text =
+  let rec replace accu start last_was_empty =
+    let startpos = if last_was_empty then start + 1 else start in
+    if startpos > String.length text
+    then string_after text start :: accu
+    else (
+      match search_forward expr text startpos with
+      | pos ->
+        let end_pos = match_end () in
+        let repl_text = repl_fun text in
+        replace
+          (repl_text :: String.sub text start (pos - start) :: accu)
+          end_pos
+          (end_pos = pos)
+      | exception Not_found -> string_after text start :: accu)
+  in
+  String.concat "" (List.rev (replace [] 0 false))
+;;
+
+let global_replace expr repl text = global_substitute expr (replacement_text repl) text
+and replace_first expr repl text = substitute_first expr (replacement_text repl) text
+
+let search_forward_progress re s p =
+  let pos = search_forward re s p in
+  if match_end () > p
+  then pos
+  else if p < String.length s
+  then search_forward re s (p + 1)
+  else raise Not_found
+;;
+
+let bounded_split expr text num =
+  let start = if string_match expr text 0 then match_end () else 0 in
+  let rec split accu start n =
+    if start >= String.length text
+    then accu
+    else if n = 1
+    then string_after text start :: accu
+    else (
+      match search_forward_progress expr text start with
+      | pos -> split (String.sub text start (pos - start) :: accu) (match_end ()) (n - 1)
+      | exception Not_found -> string_after text start :: accu)
+  in
+  List.rev (split [] start num)
+;;
+
+let split expr text = bounded_split expr text 0
+
+let bounded_split_delim expr text num =
+  let rec split accu start n =
+    if start > String.length text
+    then accu
+    else if n = 1
+    then string_after text start :: accu
+    else (
+      match search_forward_progress expr text start with
+      | pos -> split (String.sub text start (pos - start) :: accu) (match_end ()) (n - 1)
+      | exception Not_found -> string_after text start :: accu)
+  in
+  if text = "" then [] else List.rev (split [] 0 num)
+;;
+
+let split_delim expr text = bounded_split_delim expr text 0
+
+type split_result =
+  | Text of string
+  | Delim of string
+
+let bounded_full_split expr text num =
+  let rec split accu start n =
+    if start >= String.length text
+    then accu
+    else if n = 1
+    then Text (string_after text start) :: accu
+    else (
+      match search_forward_progress expr text start with
+      | pos ->
+        let s = matched_string text in
+        if pos > start
+        then
+          split
+            (Delim s :: Text (String.sub text start (pos - start)) :: accu)
+            (match_end ())
+            (n - 1)
+        else split (Delim s :: accu) (match_end ()) (n - 1)
+      | exception Not_found -> Text (string_after text start) :: accu)
+  in
+  List.rev (split [] 0 num)
+;;
+
+let full_split expr text = bounded_full_split expr text 0

unikernel/duniverse/ocaml-re/lib/str.mli

@@ -0,0 +1,220 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  linking exception.                                                 *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: re_str.mli,v 1.1 2002/01/16 14:16:04 vouillon Exp $ *)
+
+(** Module [Str]: regular expressions and high-level string processing *)
+
+(** {2 Regular expressions} *)
+
+(** The type of compiled regular expressions. *)
+type regexp
+
+(** Compile a regular expression. The syntax for regular expressions
+    is the same as in Gnu Emacs. The special characters are
+    [$^.*+?[]]. The following constructs are recognized:
+    - [.     ] matches any character except newline
+    - [*     ] (postfix) matches the previous expression zero, one or
+      several times
+    - [+     ] (postfix) matches the previous expression one or
+      several times
+    - [?     ] (postfix) matches the previous expression once or
+      not at all
+    - [[..]  ] character set; ranges are denoted with [-], as in [[a-z]];
+      an initial [^], as in [[^0-9]], complements the set
+    - [^     ] matches at beginning of line
+    - [$     ] matches at end of line
+    - [\|    ] (infix) alternative between two expressions
+    - [\(..\)] grouping and naming of the enclosed expression
+    - [\1    ] the text matched by the first [\(...\)] expression
+      ([\2] for the second expression, etc)
+    - [\b    ] matches word boundaries
+    - [\     ] quotes special characters. *)
+val regexp : string -> regexp
+
+(** Same as [regexp], but the compiled expression will match text
+    in a case-insensitive way: uppercase and lowercase letters will
+    be considered equivalent. *)
+val regexp_case_fold : string -> regexp
+
+(** [Str.quote s] returns a regexp string that matches exactly
+    [s] and nothing else. *)
+val quote : string -> string
+
+(** [Str.regexp_string s] returns a regular expression
+    that matches exactly [s] and nothing else. *)
+val regexp_string : string -> regexp
+
+(** [Str.regexp_string_case_fold] is similar to [Str.regexp_string], but the regexp
+    matches in a case-insensitive way. *)
+val regexp_string_case_fold : string -> regexp
+
+(** {2 String matching and searching} *)
+
+(** [string_match r s start] tests whether the characters in [s]
+    starting at position [start] match the regular expression [r].
+    The first character of a string has position [0], as usual. *)
+val string_match : regexp -> string -> int -> bool
+
+(** [search_forward r s start] searches the string [s] for a substring
+    matching the regular expression [r]. The search starts at position
+    [start] and proceeds towards the end of the string.
+    Return the position of the first character of the matched
+    substring, or raise [Not_found] if no substring matches. *)
+val search_forward : regexp -> string -> int -> int
+
+(** Same as [search_forward], but the search proceeds towards the
+    beginning of the string. *)
+val search_backward : regexp -> string -> int -> int
+
+(** Similar to [string_match], but succeeds whenever the argument
+    string is a prefix of a string that matches.  This includes
+    the case of a true complete match. *)
+val string_partial_match : regexp -> string -> int -> bool
+
+(** [matched_string s] returns the substring of [s] that was matched
+    by the latest [string_match], [search_forward] or [search_backward].
+    The user must make sure that the parameter [s] is the same string
+    that was passed to the matching or searching function. *)
+val matched_string : string -> string
+
+(** [match_beginning ()] returns the position of the first character
+    of the substring that was matched by [string_match],
+    [search_forward] or [search_backward]. *)
+val match_beginning : unit -> int
+
+(** [match_end ()] returns the position of the character following the
+    last character of the substring that was matched by [string_match],
+    [search_forward] or [search_backward]. *)
+val match_end : unit -> int
+
+(** [matched_group n s] returns the substring of [s] that was matched
+    by the [n]th group [\(...\)] of the regular expression during
+    the latest [string_match], [search_forward] or [search_backward].
+    The user must make sure that the parameter [s] is the same string
+    that was passed to the matching or searching function.
+    [matched_group n s] raises [Not_found] if the [n]th group
+    of the regular expression was not matched.  This can happen
+    with groups inside alternatives [\|], options [?]
+    or repetitions [*].  For instance, the empty string will match
+    [\(a\)*], but [matched_group 1 ""] will raise [Not_found]
+    because the first group itself was not matched. *)
+val matched_group : int -> string -> string
+
+(** [group_beginning n] returns the position of the first character
+    of the substring that was matched by the [n]th group of the regular expression.
+    Raises [Not_found] if the [n]th group of the regular expression was not matched. *)
+val group_beginning : int -> int
+
+(** [group_end n] returns the position of the character following
+    the last character of the matched substring.
+    Raises [Not_found] if the [n]th group of the regular expression was not matched. *)
+val group_end : int -> int
+
+(** {2 Replacement} *)
+
+(** [global_replace regexp templ s] returns a string identical to [s],
+    except that all substrings of [s] that match [regexp] have been
+    replaced by [templ]. The replacement template [templ] can contain
+    [\1], [\2], etc; these sequences will be replaced by the text
+    matched by the corresponding group in the regular expression.
+    [\0] stands for the text matched by the whole regular expression. *)
+val global_replace : regexp -> string -> string -> string
+
+(** Same as [global_replace], except that only the first substring
+    matching the regular expression is replaced. *)
+val replace_first : regexp -> string -> string -> string
+
+(** [global_substitute regexp subst s] returns a string identical
+    to [s], except that all substrings of [s] that match [regexp]
+    have been replaced by the result of function [subst]. The
+    function [subst] is called once for each matching substring,
+    and receives [s] (the whole text) as argument. *)
+val global_substitute : regexp -> (string -> string) -> string -> string
+
+(** Same as [global_substitute], except that only the first substring
+    matching the regular expression is replaced. *)
+val substitute_first : regexp -> (string -> string) -> string -> string
+
+(** [replace_matched repl s] returns the replacement text [repl]
+    in which [\1], [\2], etc. have been replaced by the text
+    matched by the corresponding groups in the most recent matching
+    operation.  [s] must be the same string that was matched during
+    this matching operation. *)
+val replace_matched : string -> string -> string
+
+(** {2 Splitting} *)
+
+(** [split r s] splits [s] into substrings, taking as delimiters
+    the substrings that match [r], and returns the list of substrings.
+    For instance, [split (regexp "[ \t]+") s] splits [s] into
+    blank-separated words.  An occurrence of the delimiter at the
+    beginning and at the end of the string is ignored. *)
+val split : regexp -> string -> string list
+
+(** Same as [split], but splits into at most [n] substrings,
+    where [n] is the extra integer parameter. *)
+val bounded_split : regexp -> string -> int -> string list
+
+(** Same as [split], but occurrences of the delimiter at the beginning
+    and at the end of the string are recognized and returned as empty strings
+    in the result.
+    For instance, [split_delim (regexp " ") " abc "] returns [[""; "abc"; ""]],
+    while [split] with the same arguments returns [["abc"]]. *)
+val split_delim : regexp -> string -> string list
+
+(** Same as [bounded_split] and [split_delim], but occurrences of
+    the delimiter at the beginning and at the end of the string are recognized
+    and returned as empty strings in the result.
+    For instance, [split_delim (regexp " ") " abc "] returns [[""; "abc"; ""]],
+    while [split] with the same arguments returns [["abc"]]. *)
+val bounded_split_delim : regexp -> string -> int -> string list
+
+type split_result =
+  | Text of string
+  | Delim of string
+
+(** Same as [split_delim], but returns the delimiters
+    as well as the substrings contained between delimiters.
+    The former are tagged [Delim] in the result list;
+    the latter are tagged [Text].
+    For instance, [full_split (regexp "[{}]") "{ab}"] returns
+    [[Delim "{"; Text "ab"; Delim "}"]]. *)
+val full_split : regexp -> string -> split_result list
+
+(** Same as [split_delim] and [bounded_split_delim], but returns
+    the delimiters as well as the substrings contained between delimiters.
+    The former are tagged [Delim] in the result list;
+    the latter are tagged [Text].
+    For instance, [full_split (regexp "[{}]") "{ab}"] returns
+    [[Delim "{"; Text "ab"; Delim "}"]]. *)
+val bounded_full_split : regexp -> string -> int -> split_result list
+
+(** {2 Extracting substrings} *)
+
+(** [string_before s n] returns the substring of all characters of [s]
+    that precede position [n] (excluding the character at
+    position [n]). *)
+val string_before : string -> int -> string
+
+(** [string_after s n] returns the substring of all characters of [s]
+    that follow position [n] (including the character at
+    position [n]). *)
+val string_after : string -> int -> string
+
+(** [first_chars s n] returns the first [n] characters of [s].
+    This is the same function as [string_before]. *)
+val first_chars : string -> int -> string
+
+(** [last_chars s n] returns the last [n] characters of [s]. *)
+val last_chars : string -> int -> string

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

@@ -0,0 +1,90 @@
+open Import
+
+module Cset = struct
+  include Cset
+
+  module Range = struct
+    type t =
+      { first : Char.t
+      ; last : Char.t
+      }
+
+    let first t = t.first
+    let last t = t.last
+  end
+
+  let view t =
+    fold_right t ~init:[] ~f:(fun first last acc ->
+      let range = { Range.first = Cset.to_char first; last = Cset.to_char last } in
+      range :: acc)
+  ;;
+end
+
+module Sem = Automata.Sem
+module Rep_kind = Automata.Rep_kind
+
+type t =
+  | Set of Cset.t
+  | Sequence of Ast.t list
+  | Alternative of Ast.t list
+  | Repeat of Ast.t * int * int option
+  | Beg_of_line
+  | End_of_line
+  | Beg_of_word
+  | End_of_word
+  | Not_bound
+  | Beg_of_str
+  | End_of_str
+  | Last_end_of_line
+  | Start
+  | Stop
+  | Sem of Automata.Sem.t * Ast.t
+  | Sem_greedy of Automata.Rep_kind.t * Ast.t
+  | Group of string option * Ast.t
+  | No_group of Ast.t
+  | Nest of Ast.t
+  | Case of Ast.t
+  | No_case of Ast.t
+  | Intersection of Ast.t list
+  | Complement of Ast.t list
+  | Difference of Ast.t * Ast.t
+  | Pmark of Pmark.t * Ast.t
+
+let view_ast f (t : _ Ast.ast) : t =
+  match t with
+  | Alternative a -> Alternative (List.map ~f a)
+  | No_case a -> No_case (f a)
+  | Case a -> Case (f a)
+;;
+
+let view_set (cset : Ast.cset) : t =
+  match cset with
+  | Cset set -> Set set
+  | Intersection sets -> Intersection (List.map sets ~f:Ast.t_of_cset)
+  | Complement sets -> Complement (List.map sets ~f:Ast.t_of_cset)
+  | Difference (x, y) -> Difference (Ast.t_of_cset x, Ast.t_of_cset y)
+  | Cast ast -> view_ast Ast.t_of_cset ast
+;;
+
+let view : Ast.t -> t = function
+  | Set s -> view_set s
+  | Ast s -> view_ast (fun x -> x) s
+  | Sem (sem, a) -> Sem (sem, a)
+  | Sem_greedy (sem, a) -> Sem_greedy (sem, a)
+  | Sequence s -> Sequence s
+  | Repeat (t, x, y) -> Repeat (t, x, y)
+  | Beg_of_line -> Beg_of_line
+  | End_of_line -> End_of_line
+  | Beg_of_word -> Beg_of_word
+  | End_of_word -> End_of_word
+  | Not_bound -> Not_bound
+  | Beg_of_str -> Beg_of_str
+  | End_of_str -> End_of_str
+  | Last_end_of_line -> Last_end_of_line
+  | Start -> Start
+  | Stop -> Stop
+  | No_group a -> No_group a
+  | Group (name, t) -> Group (name, t)
+  | Nest t -> Nest t
+  | Pmark (pmark, t) -> Pmark (pmark, t)
+;;

unikernel/duniverse/ocaml-re/lib/view.mli

@@ -0,0 +1,58 @@
+(** A view of the top-level of a regex. This type is unstable and may change *)
+
+module Cset : sig
+  type t = Cset.t
+
+  module Range : sig
+    type t
+
+    val first : t -> Char.t
+    val last : t -> Char.t
+  end
+
+  val view : t -> Range.t list
+end
+
+module Sem : sig
+  type t =
+    [ `Longest
+    | `Shortest
+    | `First
+    ]
+end
+
+module Rep_kind : sig
+  type t =
+    [ `Greedy
+    | `Non_greedy
+    ]
+end
+
+type t =
+  | Set of Cset.t
+  | Sequence of Ast.t list
+  | Alternative of Ast.t list
+  | Repeat of Ast.t * int * int option
+  | Beg_of_line
+  | End_of_line
+  | Beg_of_word
+  | End_of_word
+  | Not_bound
+  | Beg_of_str
+  | End_of_str
+  | Last_end_of_line
+  | Start
+  | Stop
+  | Sem of Sem.t * Ast.t
+  | Sem_greedy of Rep_kind.t * Ast.t
+  | Group of string option * Ast.t
+  | No_group of Ast.t
+  | Nest of Ast.t
+  | Case of Ast.t
+  | No_case of Ast.t
+  | Intersection of Ast.t list
+  | Complement of Ast.t list
+  | Difference of Ast.t * Ast.t
+  | Pmark of Pmark.t * Ast.t
+
+val view : Ast.t -> t