README.md

@@ -79,19 +79,6 @@ where:
 Unlike ocamllex, lexers work on stream of Unicode codepoints, not
 bytes.
 
-Like ocamllex, sedlex uses **longest match** with **first rule priority**:
-
-- The lexer always tries to match the longest possible prefix of the
-  input.  It does so by continuing to read characters as long as some
-  rule can still match a longer string, while remembering the last
-  position at which a rule did match.
-
-- When two or more rules match the same longest prefix (a tie), the
-  rule that appears first in the `match%sedlex` definition wins.  For
-  example, given the rules `| "if" -> ...` and `| Plus ('a'..'z') -> ...`,
-  the input `"if"` is matched by the first rule because it is listed
-  first, even though the second rule also accepts `"if"`.
-
 The actions can call functions from the Sedlexing module to extract
 (parts of) the matched lexeme, in the desired encoding.
 

dune-project

@@ -8,8 +8,6 @@
 (authors "xenia <xenia@awoo.systems>")
 (maintainers "xenia <xenia@awoo.systems")
 (homepage "https://git.lain.faith/noslop/noslop-sedlex.git")
-(maintenance_intent "(latest)")
-(documentation "https://git.lain.faith/noslop/noslop-sedlex/wiki")
 
 (generate_opam_files true)
 (executables_implicit_empty_intf true)

examples/dune

@@ -2,7 +2,8 @@
  (names tokenizer regressions complement subtraction repeat performance)
  (libraries noslop-sedlex noslop-sedlex.ppx)
  (preprocess
-  (pps noslop-sedlex.ppx)))
+  (pps noslop-sedlex.ppx))
+ (flags :standard -w +39))
 
 (rule
  (alias runtest)

flake.nix

@@ -2,7 +2,22 @@
   description = "Flake for noslop-sedlex";
 
   outputs = { self, dragnpkgs } @ inputs: dragnpkgs.lib.mkFlake {
-    packages.default = { ocamlPackages }: ocamlPackages.callPackage ./package.nix {};
+    packages.default = { ocamlPackages }: ocamlPackages.buildDunePackage rec {
+      pname = "noslop-sedlex";
+      version = "3.7+DEV";
+      src = self;
+
+      minimalOCamlVersion = "5.3";
+
+      propagatedBuildInputs = with ocamlPackages; [
+        gen
+        ppxlib
+        ppx_expect
+      ];
+
+      nativeBuildInputs = with ocamlPackages; [
+      ];
+    };
 
     devShells.default = { ocamlPackages, stdenv, mkShell }: mkShell {
       packages = with ocamlPackages; [

noslop-sedlex.opam

@@ -11,7 +11,6 @@ maintainer: ["xenia <xenia@awoo.systems"]
 authors: ["xenia <xenia@awoo.systems>"]
 license: "LicenseRef-Proprietary"
 homepage: "https://git.lain.faith/noslop/noslop-sedlex.git"
-doc: "https://git.lain.faith/noslop/noslop-sedlex/wiki"
 depends: [
   "ocaml" {>= "4.08"}
   "dune" {>= "3.20"}

package.nix

@@ -1,54 +0,0 @@
-{
-  lib,
-  fetchurl,
-  buildDunePackage,
-  gen,
-  ppxlib,
-  uchar,
-  ppx_expect,
-}: let
-  unicodeVersion = "17.0.0";
-  baseUrl = "https://www.unicode.org/Public/${unicodeVersion}";
-
-  DerivedCoreProperties = fetchurl {
-    url = "${baseUrl}/ucd/DerivedCoreProperties.txt";
-    hash = "sha256-JMf+0RlcSC+q79XB5+uCHF7h+23gfs26pktWqZ2iLAg=";
-  };
-  DerivedGeneralCategory = fetchurl {
-    url = "${baseUrl}/ucd/extracted/DerivedGeneralCategory.txt";
-    hash = "sha256-1i5bq3DKdPCZND9xIk+gUcsf3WGhq0XASIxEz8C2EC4=";
-  };
-  PropList = fetchurl {
-    url = "${baseUrl}/ucd/PropList.txt";
-    hash = "sha256-Ew3N3Kra8HEAi9/OHndD4E/fvJEIhvAX2fmskx2MZN0=";
-  };
-in
-buildDunePackage (finalAttrs: {
-  pname = "noslop-sedlex";
-  version = "3.7+DEV";
-
-  minimalOCamlVersion = "5.3";
-
-  src = ./.;
-
-  propagatedBuildInputs = [
-    gen
-    ppxlib
-    uchar
-  ];
-
-  preBuild = ''
-    rm src/generator/data/dune
-    ln -s ${DerivedCoreProperties} src/generator/data/DerivedCoreProperties.txt
-    ln -s ${DerivedGeneralCategory} src/generator/data/DerivedGeneralCategory.txt
-    ln -s ${PropList} src/generator/data/PropList.txt
-  '';
-
-  checkInputs = [
-    ppx_expect
-  ];
-
-  doCheck = true;
-
-  dontStrip = true;
-})

src/common/cset.ml

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 (* Character sets are represented as lists of intervals.  The
    intervals must be non-overlapping and not collapsable, and the list

src/common/cset.mli

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 (** Representation of sets of unicode code points. *)
 

src/lib/dune

@@ -2,4 +2,5 @@
  (name sedlex)
  (public_name noslop-sedlex)
  (wrapped false)
- (libraries gen))
+ (libraries gen)
+ (flags :standard -w +A-4-9 -safe-string))

src/lib/sedlexing.ml

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 exception InvalidCodepoint of int
 exception MalFormed
@@ -454,7 +455,7 @@ module Utf8 = struct
       let p =
         ((n1 land 0x0f) lsl 12) lor ((n2 land 0x3f) lsl 6) lor (n3 land 0x3f)
       in
-      if p >= 0xd800 && p <= 0xdfff then raise MalFormed;
+      if p >= 0xd800 && p <= 0xdf00 then raise MalFormed;
       p
 
     let check_four n1 n2 n3 n4 =

src/lib/sedlexing.mli

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 (** Runtime support for lexers generated by [sedlex]. *)
 

src/syntax/dune

@@ -5,7 +5,9 @@
  (libraries ppxlib noslop-sedlex noslop-sedlex.utils)
  (ppx_runtime_libraries noslop-sedlex)
  (preprocess
-  (pps ppxlib.metaquot)))
+  (pps ppxlib.metaquot))
+ (flags
+  (:standard -w -9)))
 
 (rule
  (targets unicode.ml)

src/syntax/ppx_sedlex.ml

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 open Ppxlib
 open Ast_builder.Default
@@ -197,14 +198,14 @@ let best_final final =
 let state_fun state = Printf.sprintf "__sedlex_state_%i" state
 
 let call_state lexbuf auto state =
-  let { Sedlex.trans; finals } = auto.(state) in
+  let trans, final = auto.(state) in
   if Array.length trans = 0 then (
-    match best_final finals with
+    match best_final final with
       | Some i -> eint ~loc:default_loc i
       | None -> assert false)
   else appfun (state_fun state) [lexbuf]
 
-let gen_state (lexbuf_name, lexbuf) auto i { Sedlex.trans; finals } =
+let gen_state (lexbuf_name, lexbuf) auto i (trans, final) =
   let loc = default_loc in
   let partition = Array.map fst trans in
   let cases =
@@ -234,7 +235,7 @@ let gen_state (lexbuf_name, lexbuf) auto i { Sedlex.trans; finals } =
         ~expr:(Exp.fun_ ~loc Nolabel None lhs body);
     ]
   in
-  match best_final finals with
+  match best_final final with
     | None -> ret (body ())
     | Some _ when Array.length trans = 0 -> []
     | Some i ->
@@ -248,19 +249,25 @@ let gen_recflag auto =
      in states with no further transitions. *)
   try
     Array.iter
-      (fun { Sedlex.trans; _ } ->
+      (fun (trans_i, _) ->
         Array.iter
           (fun (_, j) ->
-            if Array.length auto.(j).Sedlex.trans > 0 then raise Exit)
-          trans)
+            let trans_j, _ = auto.(j) in
+            if Array.length trans_j > 0 then raise Exit)
+          trans_i)
       auto;
     Nonrecursive
   with Exit -> Recursive
 
-let gen_definition ((_, lexbuf) as lexbuf_with_name) auto l error =
+let gen_definition ((_, lexbuf) as lexbuf_with_name) l error =
   let loc = default_loc in
+  let brs = Array.of_list l in
+  let auto = Sedlex.compile (Array.map fst brs) in
   let cases =
-    List.mapi (fun i (_, e) -> case ~lhs:(pint ~loc i) ~guard:None ~rhs:e) l
+    Array.to_list
+      (Array.mapi
+         (fun i (_, e) -> case ~lhs:(pint ~loc i) ~guard:None ~rhs:e)
+         brs)
   in
   let states = Array.mapi (gen_state lexbuf_with_name auto) auto in
   let states = List.flatten (Array.to_list states) in
@@ -325,21 +332,21 @@ let rec repeat r = function
   | n, m -> Sedlex.seq r (repeat r (n - 1, m - 1))
 
 let regexp_of_pattern env =
-  let rec char_pair_op func name ~encoding ~loc tuple =
+  let rec char_pair_op func name ~encoding p tuple =
     (* Construct something like Sub(a,b) *)
       match tuple with
-      | Some { ppat_desc = Ppat_tuple [p0; p1]; _ } ->
+      | Some { ppat_desc = Ppat_tuple [p0; p1] } ->
           begin match func (aux ~encoding p0) (aux ~encoding p1) with
             | Some r -> r
             | None ->
-                err loc
+                err p.ppat_loc
                   "the %s operator can only applied to single-character length \
                    regexps"
                   name
           end
       | _ ->
-          err loc "the %s operator requires two arguments, like %s(a,b)" name
-            name
+          err p.ppat_loc "the %s operator requires two arguments, like %s(a,b)"
+            name name
   and aux ~encoding p =
     (* interpret one pattern node *)
       match p.ppat_desc with
@@ -348,18 +355,18 @@ let regexp_of_pattern env =
           List.fold_left
             (fun r p -> Sedlex.seq r (aux ~encoding p))
             (aux ~encoding p) pl
-      | Ppat_construct ({ txt = Lident "Star"; _ }, Some (_, p)) ->
+      | Ppat_construct ({ txt = Lident "Star" }, Some (_, p)) ->
           Sedlex.rep (aux ~encoding p)
-      | Ppat_construct ({ txt = Lident "Plus"; _ }, Some (_, p)) ->
+      | Ppat_construct ({ txt = Lident "Plus" }, Some (_, p)) ->
           Sedlex.plus (aux ~encoding p)
-      | Ppat_construct ({ txt = Lident "Utf8"; _ }, Some (_, p)) ->
+      | Ppat_construct ({ txt = Lident "Utf8" }, Some (_, p)) ->
           aux ~encoding:Utf8 p
-      | Ppat_construct ({ txt = Lident "Latin1"; _ }, Some (_, p)) ->
+      | Ppat_construct ({ txt = Lident "Latin1" }, Some (_, p)) ->
           aux ~encoding:Latin1 p
-      | Ppat_construct ({ txt = Lident "Ascii"; _ }, Some (_, p)) ->
+      | Ppat_construct ({ txt = Lident "Ascii" }, Some (_, p)) ->
           aux ~encoding:Ascii p
       | Ppat_construct
-          ( { txt = Lident "Rep"; _ },
+          ( { txt = Lident "Rep" },
             Some
               ( _,
                 {
@@ -370,10 +377,8 @@ let regexp_of_pattern env =
                         {
                           ppat_desc =
                             Ppat_constant (i1 as i2) | Ppat_interval (i1, i2);
-                          _;
                         };
                       ];
-                  _;
                 } ) ) ->
           begin match (i1, i2) with
             | Pconst_integer (i1, _), Pconst_integer (i2, _) ->
@@ -384,11 +389,11 @@ let regexp_of_pattern env =
             | _ ->
                 err p.ppat_loc "Rep must take an integer constant or interval"
           end
-      | Ppat_construct ({ txt = Lident "Rep"; _ }, _) ->
+      | Ppat_construct ({ txt = Lident "Rep" }, _) ->
           err p.ppat_loc "the Rep operator takes 2 arguments"
-      | Ppat_construct ({ txt = Lident "Opt"; _ }, Some (_, p)) ->
+      | Ppat_construct ({ txt = Lident "Opt" }, Some (_, p)) ->
           Sedlex.alt Sedlex.eps (aux ~encoding p)
-      | Ppat_construct ({ txt = Lident "Compl"; _ }, arg) ->
+      | Ppat_construct ({ txt = Lident "Compl" }, arg) ->
           begin match arg with
             | Some (_, p0) ->
                 begin match Sedlex.compl (aux ~encoding p0) with
@@ -400,16 +405,16 @@ let regexp_of_pattern env =
                 end
             | _ -> err p.ppat_loc "the Compl operator requires an argument"
           end
-      | Ppat_construct ({ txt = Lident "Sub"; _ }, arg) ->
-          char_pair_op ~encoding Sedlex.subtract "Sub" ~loc:p.ppat_loc
+      | Ppat_construct ({ txt = Lident "Sub" }, arg) ->
+          char_pair_op ~encoding Sedlex.subtract "Sub" p
             (Option.map (fun (_, arg) -> arg) arg)
-      | Ppat_construct ({ txt = Lident "Intersect"; _ }, arg) ->
-          char_pair_op ~encoding Sedlex.intersection "Intersect" ~loc:p.ppat_loc
+      | Ppat_construct ({ txt = Lident "Intersect" }, arg) ->
+          char_pair_op ~encoding Sedlex.intersection "Intersect" p
             (Option.map (fun (_, arg) -> arg) arg)
-      | Ppat_construct ({ txt = Lident "Chars"; _ }, arg) -> (
+      | Ppat_construct ({ txt = Lident "Chars" }, arg) -> (
           let const =
             match arg with
-              | Some (_, { ppat_desc = Ppat_constant const; _ }) -> Some const
+              | Some (_, { ppat_desc = Ppat_constant const }) -> Some const
               | _ -> None
           in
           match const with
@@ -454,7 +459,7 @@ let regexp_of_pattern env =
                 Sedlex.chars (Cset.singleton (codepoint (int_of_string i)))
             | _ -> err p.ppat_loc "this pattern is not a valid regexp"
           end
-      | Ppat_var { txt = x; _ } ->
+      | Ppat_var { txt = x } ->
           begin try StringMap.find x env
           with Not_found -> err p.ppat_loc "unbound regexp %s" x
           end
@@ -462,46 +467,6 @@ let regexp_of_pattern env =
   in
   aux ~encoding:Ascii
 
-let handle_sedlex_match ~env ~map_rhs match_expr =
-  let lexbuf =
-    match match_expr with
-      | { pexp_desc = Pexp_match (lexbuf, _); _ } -> (
-          match lexbuf with
-            | { pexp_desc = Pexp_ident { txt = Lident txt; _ }; _ } ->
-                (txt, lexbuf)
-            | _ ->
-                err lexbuf.pexp_loc
-                  "the matched expression must be a single identifier")
-      | _ ->
-          err match_expr.pexp_loc
-            "the %%sedlex extension is only recognized on match expressions"
-  in
-  let cases =
-    match match_expr with
-      | { pexp_desc = Pexp_match (_, cases); _ } -> cases
-      | _ -> assert false
-  in
-  let cases = List.rev cases in
-  let error =
-    match List.hd cases with
-      | { pc_lhs = [%pat? _]; pc_rhs = e; pc_guard = None } -> map_rhs e
-      | { pc_lhs = p; _ } ->
-          err p.ppat_loc "the last branch must be a catch-all error case"
-  in
-  let cases = List.rev (List.tl cases) in
-  let cases =
-    List.map
-      (function
-        | { pc_lhs = p; pc_rhs = e; pc_guard = None } ->
-            (regexp_of_pattern env p, map_rhs e)
-        | { pc_guard = Some e; _ } ->
-            err e.pexp_loc "'when' guards are not supported")
-      cases
-  in
-  let brs = Array.of_list cases in
-  let auto = Sedlex.compile (Array.map fst brs) in
-  (gen_definition lexbuf auto cases error, auto)
-
 let previous = ref []
 let regexps = ref []
 let should_set_cookies = ref false
@@ -516,11 +481,37 @@ let mapper =
 
     method! expression e =
       match e with
-        | [%expr [%sedlex [%e? { pexp_desc = Pexp_match _; _ } as match_expr]]]
-          ->
-            fst (handle_sedlex_match ~env ~map_rhs:this#expression match_expr)
+        | [%expr [%sedlex [%e? { pexp_desc = Pexp_match (lexbuf, cases) }]]] ->
+            let lexbuf =
+              match lexbuf with
+                | { pexp_desc = Pexp_ident { txt = Lident txt } } ->
+                    (txt, lexbuf)
+                | _ ->
+                    err lexbuf.pexp_loc
+                      "the matched expression must be a single identifier"
+            in
+            let cases = List.rev cases in
+            let error =
+              match List.hd cases with
+                | { pc_lhs = [%pat? _]; pc_rhs = e; pc_guard = None } ->
+                    this#expression e
+                | { pc_lhs = p } ->
+                    err p.ppat_loc
+                      "the last branch must be a catch-all error case"
+            in
+            let cases = List.rev (List.tl cases) in
+            let cases =
+              List.map
+                (function
+                  | { pc_lhs = p; pc_rhs = e; pc_guard = None } ->
+                      (regexp_of_pattern env p, this#expression e)
+                  | { pc_guard = Some e } ->
+                      err e.pexp_loc "'when' guards are not supported")
+                cases
+            in
+            gen_definition lexbuf cases error
         | [%expr
-            let [%p? { ppat_desc = Ppat_var { txt = name; _ }; _ }] =
+            let [%p? { ppat_desc = Ppat_var { txt = name } }] =
               [%sedlex.regexp? [%p? p]]
             in
             [%e? body]] ->
@@ -540,7 +531,7 @@ let mapper =
           (List.map
              (function
                | [%stri
-                   let [%p? { ppat_desc = Ppat_var { txt = name; _ }; _ }] =
+                   let [%p? { ppat_desc = Ppat_var { txt = name } }] =
                      [%sedlex.regexp? [%p? p]]] as i ->
                    regexps := i :: !regexps;
                    mapper := !mapper#define_regexp name p;
@@ -565,7 +556,7 @@ let mapper =
 let pre_handler cookies =
   previous :=
     match Driver.Cookies.get cookies "sedlex.regexps" Ast_pattern.__ with
-      | Some { pexp_desc = Pexp_extension (_, PStr l); _ } -> l
+      | Some { pexp_desc = Pexp_extension (_, PStr l) } -> l
       | Some _ -> assert false
       | None -> []
 

src/syntax/sedlex.ml

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 module Cset = Sedlex_cset
 
@@ -24,7 +25,7 @@ let new_node () =
 let seq r1 r2 succ = r1 (r2 succ)
 
 let is_chars final = function
-  | { eps = []; trans = [(c, f)]; _ } when f == final -> Some c
+  | { eps = []; trans = [(c, f)] } when f == final -> Some c
   | _ -> None
 
 let chars c succ =
@@ -116,9 +117,6 @@ let transition (state : state) =
   Array.sort (fun (c1, _) (c2, _) -> compare c1 c2) t;
   t
 
-type dfa_state = { trans : (Cset.t * int) array; finals : bool array }
-type dfa = dfa_state array
-
 let compile rs =
   let rs = Array.map compile_re rs in
   let counter = ref 0 in
@@ -133,7 +131,7 @@ let compile rs =
       let trans = transition state in
       let trans = Array.map (fun (p, t) -> (p, aux t)) trans in
       let finals = Array.map (fun (_, f) -> List.memq f state) rs in
-      Hashtbl.add states_def i { trans; finals };
+      Hashtbl.add states_def i (trans, finals);
       i
   in
   let init = ref [] in
@@ -141,56 +139,3 @@ let compile rs =
   let i = aux !init in
   assert (i = 0);
   Array.init !counter (Hashtbl.find states_def)
-
-let cset_to_label cset =
-  let escape_dot c =
-    match c with
-      | '"' -> "\\\""
-      | '\\' -> "\\\\"
-      | '<' -> "\\<"
-      | '>' -> "\\>"
-      | _ -> String.make 1 c
-  in
-  let format_interval (lo, hi) =
-    if lo = -1 && hi = -1 then "EOF"
-    else if lo = hi then
-      if lo >= 32 && lo <= 126 then "'" ^ escape_dot (Char.chr lo) ^ "'"
-      else Printf.sprintf "U+%04X" lo
-    else if lo >= 32 && lo <= 126 && hi >= 32 && hi <= 126 then
-      "'" ^ escape_dot (Char.chr lo) ^ "'-'" ^ escape_dot (Char.chr hi) ^ "'"
-    else Printf.sprintf "U+%04X-U+%04X" lo hi
-  in
-  String.concat ", "
-    (List.map format_interval (cset : Cset.t :> (int * int) list))
-
-let dfa_to_dot dfa =
-  let buf = Buffer.create 1024 in
-  let bprintf = Printf.bprintf in
-  bprintf buf "digraph {\n";
-  bprintf buf "  rankdir=LR;\n";
-  bprintf buf "  node [shape=circle];\n\n";
-  bprintf buf "  _start [shape=point];\n";
-  bprintf buf "  _start -> state0;\n\n";
-  Array.iteri
-    (fun i { trans; finals } ->
-      let accepted =
-        let acc = ref [] in
-        for r = Array.length finals - 1 downto 0 do
-          if finals.(r) then acc := r :: !acc
-        done;
-        !acc
-      in
-      (match accepted with
-        | [] -> bprintf buf "  state%d [label=\"%d\"];\n" i i
-        | rules ->
-            bprintf buf
-              "  state%d [label=\"%d\\n[rule %s]\", shape=doublecircle];\n" i i
-              (String.concat "," (List.map string_of_int rules)));
-      Array.iter
-        (fun (cset, target) ->
-          let label = cset_to_label cset in
-          bprintf buf "  state%d -> state%d [label=\"%s\"];\n" i target label)
-        trans)
-    dfa;
-  bprintf buf "}\n";
-  Buffer.contents buf

src/syntax/sedlex.mli

@@ -1,5 +1,6 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 type regexp
 
@@ -21,8 +22,4 @@ val intersection : regexp -> regexp -> regexp option
 (* If each argument is a single [chars] regexp, returns a regexp
    which matches the intersection set.  Otherwise returns [None]. *)
 
-type dfa_state = { trans : (Sedlex_cset.t * int) array; finals : bool array }
-type dfa = dfa_state array
-
-val compile : regexp array -> dfa
-val dfa_to_dot : dfa -> string
+val compile : regexp array -> ((Sedlex_cset.t * int) array * bool array) array

src/syntax/sedlex_cset.ml

@@ -1,4 +1,5 @@
+(* The package sedlex is released under the terms of an MIT-like license. *)
+(* See the attached LICENSE file.                                         *)
 (* Copyright 2005, 2013 by Alain Frisch and LexiFi.                       *)
-(* Copyright 2026 by xenia <xenia@awoo.systems>                           *)
 
 include Sedlex_utils.Cset

test/codegen/dune

@@ -1,8 +0,0 @@
-(library
- (name sedlex_gen_test)
- (libraries noslop-sedlex)
- (inline_tests)
- (enabled_if
-  (>= %{ocaml_version} 4.14))
- (preprocess
-  (pps ppx_sedlex_test ppx_expect)))

test/codegen/test_gen.ml

@@ -1,120 +0,0 @@
-let%expect_test "simple string match" =
-  (match%sedlex_test buf with "ab" | "de" -> () | _ -> ());
-  [%expect
-    {|
-    DOT:
-    digraph {
-      rankdir=LR;
-      node [shape=circle];
-
-      _start [shape=point];
-      _start -> state0;
-
-      state0 [label="0"];
-      state0 -> state1 [label="'a'"];
-      state0 -> state3 [label="'d'"];
-      state1 [label="1"];
-      state1 -> state2 [label="'b'"];
-      state2 [label="2\n[rule 0]", shape=doublecircle];
-      state3 [label="3"];
-      state3 -> state2 [label="'e'"];
-    }
-    CODE:
-    let rec __sedlex_state_0 buf =
-      match __sedlex_partition_1 (Sedlexing.__private__next_int buf) with
-      | 0 -> __sedlex_state_1 buf
-      | 1 -> __sedlex_state_3 buf
-      | _ -> Sedlexing.backtrack buf
-    and __sedlex_state_1 buf =
-      match __sedlex_partition_2 (Sedlexing.__private__next_int buf) with
-      | 0 -> 0
-      | _ -> Sedlexing.backtrack buf
-    and __sedlex_state_3 buf =
-      match __sedlex_partition_3 (Sedlexing.__private__next_int buf) with
-      | 0 -> 0
-      | _ -> Sedlexing.backtrack buf in
-    Sedlexing.start buf; (match __sedlex_state_0 buf with | 0 -> () | _ -> ())
-    |}]
-
-let%expect_test "character class" =
-  (match%sedlex_test buf with Plus 'a' .. 'z' -> () | _ -> ());
-  [%expect
-    {|
-    DOT:
-    digraph {
-      rankdir=LR;
-      node [shape=circle];
-
-      _start [shape=point];
-      _start -> state0;
-
-      state0 [label="0"];
-      state0 -> state1 [label="'a'-'z'"];
-      state1 [label="1\n[rule 0]", shape=doublecircle];
-      state1 -> state1 [label="'a'-'z'"];
-    }
-    CODE:
-    let rec __sedlex_state_0 buf =
-      match __sedlex_partition_1 (Sedlexing.__private__next_int buf) with
-      | 0 -> __sedlex_state_1 buf
-      | _ -> Sedlexing.backtrack buf
-    and __sedlex_state_1 buf =
-      Sedlexing.mark buf 0;
-      (match __sedlex_partition_1 (Sedlexing.__private__next_int buf) with
-       | 0 -> __sedlex_state_1 buf
-       | _ -> Sedlexing.backtrack buf) in
-    Sedlexing.start buf; (match __sedlex_state_0 buf with | 0 -> () | _ -> ())
-    |}]
-
-let%expect_test "multi-rule" =
-  (match%sedlex_test buf with
-    | "ab" -> ()
-    | "de" -> ()
-    | Plus '0' .. '9' -> ()
-    | _ -> ());
-  [%expect
-    {|
-    DOT:
-    digraph {
-      rankdir=LR;
-      node [shape=circle];
-
-      _start [shape=point];
-      _start -> state0;
-
-      state0 [label="0"];
-      state0 -> state1 [label="'0'-'9'"];
-      state0 -> state2 [label="'a'"];
-      state0 -> state4 [label="'d'"];
-      state1 [label="1\n[rule 2]", shape=doublecircle];
-      state1 -> state1 [label="'0'-'9'"];
-      state2 [label="2"];
-      state2 -> state3 [label="'b'"];
-      state3 [label="3\n[rule 0]", shape=doublecircle];
-      state4 [label="4"];
-      state4 -> state5 [label="'e'"];
-      state5 [label="5\n[rule 1]", shape=doublecircle];
-    }
-    CODE:
-    let rec __sedlex_state_0 buf =
-      match __sedlex_partition_1 (Sedlexing.__private__next_int buf) with
-      | 0 -> __sedlex_state_1 buf
-      | 1 -> __sedlex_state_2 buf
-      | 2 -> __sedlex_state_4 buf
-      | _ -> Sedlexing.backtrack buf
-    and __sedlex_state_1 buf =
-      Sedlexing.mark buf 2;
-      (match __sedlex_partition_2 (Sedlexing.__private__next_int buf) with
-       | 0 -> __sedlex_state_1 buf
-       | _ -> Sedlexing.backtrack buf)
-    and __sedlex_state_2 buf =
-      match __sedlex_partition_3 (Sedlexing.__private__next_int buf) with
-      | 0 -> 0
-      | _ -> Sedlexing.backtrack buf
-    and __sedlex_state_4 buf =
-      match __sedlex_partition_4 (Sedlexing.__private__next_int buf) with
-      | 0 -> 1
-      | _ -> Sedlexing.backtrack buf in
-    Sedlexing.start buf;
-    (match __sedlex_state_0 buf with | 0 -> () | 1 -> () | 2 -> () | _ -> ())
-    |}]

test/ppx_test/dune

@@ -1,6 +0,0 @@
-(library
- (name ppx_sedlex_test)
- (kind ppx_rewriter)
- (libraries ppxlib noslop-sedlex.ppx)
- (preprocess
-  (pps ppxlib.metaquot)))

test/ppx_test/ppx_sedlex_test.ml

@@ -1,36 +0,0 @@
-open Ppxlib
-module P = Sedlex_ppx.Ppx_sedlex
-module S = Sedlex_ppx.Sedlex
-
-let reset_state () =
-  P.partition_counter := 0;
-  P.table_counter := 0;
-  Hashtbl.clear P.partitions;
-  Hashtbl.clear P.tables
-
-let clear_tables () =
-  Hashtbl.clear P.partitions;
-  Hashtbl.clear P.tables
-
-let expand ~ctxt:_ expr =
-  reset_state ();
-  let loc = Location.none in
-  let code_expr, auto =
-    P.handle_sedlex_match ~env:P.builtin_regexps ~map_rhs:Fun.id expr
-  in
-  let code_str = Pprintast.string_of_expression code_expr in
-  let dot_str = S.dfa_to_dot auto in
-  clear_tables ();
-  [%expr
-    print_string "DOT:\n";
-    print_string [%e Ast_builder.Default.estring ~loc dot_str];
-    print_string "CODE:\n";
-    print_string [%e Ast_builder.Default.estring ~loc code_str];
-    print_newline ()]
-
-let ext =
-  Extension.V3.declare "sedlex_test" Extension.Context.expression
-    Ast_pattern.(single_expr_payload __)
-    expand
-
-let () = Driver.register_transformation "sedlex_test" ~extensions:[ext]