Compare commits
No commits in common. "main" and "upstream/v3.6" have entirely different histories.
main
...
upstream/v
|
|
@ -0,0 +1,3 @@
|
|||
# These are the default owners for everything in the repo. They will
|
||||
# be requested for review when someone opens a pull request.
|
||||
* @alainfrisch @Drup @pmetzger
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
name: build
|
||||
|
||||
on:
|
||||
merge_group:
|
||||
pull_request:
|
||||
push:
|
||||
branches:
|
||||
- master
|
||||
schedule:
|
||||
# Prime the caches every Monday
|
||||
- cron: 0 1 * * MON
|
||||
|
||||
concurrency:
|
||||
group: ${{ github.workflow }}-${{ github.ref }}
|
||||
cancel-in-progress: true
|
||||
|
||||
jobs:
|
||||
build:
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
os:
|
||||
- ubuntu-latest
|
||||
- macos-latest
|
||||
- windows-latest
|
||||
ocaml-compiler:
|
||||
- 4.14.x
|
||||
- 5.x
|
||||
|
||||
runs-on: ${{ matrix.os }}
|
||||
|
||||
steps:
|
||||
- name: Set git to use LF
|
||||
run: |
|
||||
git config --global core.autocrlf false
|
||||
git config --global core.eol lf
|
||||
git config --global core.ignorecase false
|
||||
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Use OCaml ${{ matrix.ocaml-compiler }}
|
||||
uses: ocaml/setup-ocaml@v3
|
||||
with:
|
||||
ocaml-compiler: ${{ matrix.ocaml-compiler }}
|
||||
dune-cache: ${{ matrix.os == 'ubuntu-latest' }}
|
||||
|
||||
- run: opam install . --with-test
|
||||
|
||||
- run: opam exec -- make build
|
||||
|
||||
- run: opam exec -- make test
|
||||
|
||||
- run: opam exec -- git diff --exit-code
|
||||
|
||||
lint-fmt:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Use OCaml 4.14.x
|
||||
uses: ocaml/setup-ocaml@v3
|
||||
with:
|
||||
ocaml-compiler: 4.14.x
|
||||
dune-cache: true
|
||||
|
||||
- name: Lint fmt
|
||||
uses: ocaml/setup-ocaml/lint-fmt@v3
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
name: Check changelog
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
branches:
|
||||
- master
|
||||
types:
|
||||
- labeled
|
||||
- opened
|
||||
- reopened
|
||||
- synchronize
|
||||
- unlabeled
|
||||
|
||||
jobs:
|
||||
check-changelog:
|
||||
name: Check changelog
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Check changelog
|
||||
uses: tarides/changelog-check-action@v1
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
name: Doc build
|
||||
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- master
|
||||
|
||||
jobs:
|
||||
build_doc:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
- name: Setup OCaml
|
||||
uses: ocaml/setup-ocaml@v3
|
||||
with:
|
||||
ocaml-compiler: 4.14.x
|
||||
- name: Pin locally
|
||||
run: opam pin -y add --no-action .
|
||||
- name: Install locally
|
||||
run: opam install -y --with-doc sedlex
|
||||
- name: Build doc
|
||||
run: opam exec dune build @doc
|
||||
- name: Deploy doc
|
||||
uses: JamesIves/github-pages-deploy-action@4.1.4
|
||||
with:
|
||||
branch: gh-pages
|
||||
folder: _build/default/_doc/_html
|
||||
|
|
@ -19,4 +19,3 @@ examples/complement
|
|||
examples/tokenizer
|
||||
examples/subtraction
|
||||
_opam
|
||||
.direnv
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
version=0.29.0
|
||||
version=0.27.0
|
||||
profile = conventional
|
||||
break-separators = after
|
||||
space-around-lists = false
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
language: c
|
||||
sudo: required
|
||||
install: test -e .travis.opam.sh || wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
|
||||
script: bash -ex .travis-opam.sh
|
||||
env:
|
||||
global:
|
||||
- PACKAGE=sedlex
|
||||
matrix:
|
||||
- OCAML_VERSION=4.04
|
||||
- OCAML_VERSION=4.05
|
||||
- OCAML_VERSION=4.06
|
||||
- OCAML_VERSION=4.07
|
||||
- OCAML_VERSION=4.08
|
||||
- OCAML_VERSION=4.09
|
||||
- OCAML_VERSION=4.10
|
||||
- OCAML_VERSION=4.11
|
||||
os:
|
||||
- linux
|
||||
- osx
|
||||
|
|
@ -1,6 +1,3 @@
|
|||
# 3.7 (2025-10-06)
|
||||
- Update to unicode 17.0.0
|
||||
|
||||
# 3.6 (2025-01-05)
|
||||
- Fixed one of the ranges implementing
|
||||
Implement Corrigendum #1: UTF-8 Shortest Form
|
||||
|
|
|
|||
26
LICENSE
26
LICENSE
|
|
@ -1,6 +1,22 @@
|
|||
it's proprietary. all rights reserved. if you use this code in a way i don't like i will personally
|
||||
make your car explode into hammers
|
||||
The MIT License (MIT)
|
||||
|
||||
Portions of this code are based on "sedlex", Copyright 2005, 2014 by Alain
|
||||
Frisch and LexiFi, released under the terms of the MIT license which can be
|
||||
found in <licenses/LICENSE.sedlex>
|
||||
Copyright 2005, 2014 by Alain Frisch and LexiFi.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,27 @@
|
|||
# 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.
|
||||
|
||||
INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
|
||||
|
||||
.PHONY: build install uninstall clean doc test all
|
||||
|
||||
build:
|
||||
dune build @install
|
||||
|
||||
install:
|
||||
dune install $(INSTALL_ARGS)
|
||||
|
||||
uninstall:
|
||||
dune uninstall $(INSTALL_ARGS)
|
||||
|
||||
clean:
|
||||
dune clean
|
||||
|
||||
doc:
|
||||
dune build @doc
|
||||
|
||||
test:
|
||||
dune build @runtest
|
||||
|
||||
all: build test doc
|
||||
13
README.md
13
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.
|
||||
|
||||
|
|
|
|||
23
dune-project
23
dune-project
|
|
@ -1,21 +1,18 @@
|
|||
(lang dune 3.20)
|
||||
|
||||
(version "3.7")
|
||||
|
||||
(name noslop-sedlex)
|
||||
(source (uri "https://git.lain.faith/noslop/noslop-sedlex.git"))
|
||||
(license "LicenseRef-Proprietary")
|
||||
(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")
|
||||
(lang dune 3.0)
|
||||
(version 3.6)
|
||||
(name sedlex)
|
||||
(source (github ocaml-community/sedlex))
|
||||
(license MIT)
|
||||
(authors "Alain Frisch <alain.frisch@lexifi.com>"
|
||||
"https://github.com/ocaml-community/sedlex/graphs/contributors")
|
||||
(maintainers "Alain Frisch <alain.frisch@lexifi.com>")
|
||||
(homepage "https://github.com/ocaml-community/sedlex")
|
||||
|
||||
(generate_opam_files true)
|
||||
(executables_implicit_empty_intf true)
|
||||
|
||||
(package
|
||||
(name noslop-sedlex)
|
||||
(name sedlex)
|
||||
(synopsis "An OCaml lexer generator for Unicode")
|
||||
(description "sedlex is a lexer generator for OCaml. It is similar to ocamllex, but supports
|
||||
Unicode. Unlike ocamllex, sedlex allows lexer specifications within regular
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
(executables
|
||||
(names tokenizer regressions complement subtraction repeat performance)
|
||||
(libraries noslop-sedlex noslop-sedlex.ppx)
|
||||
(libraries sedlex sedlex_ppx)
|
||||
(preprocess
|
||||
(pps noslop-sedlex.ppx)))
|
||||
(pps sedlex.ppx))
|
||||
(flags :standard -w +39))
|
||||
|
||||
(rule
|
||||
(alias runtest)
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
module CSet = Sedlex_ppx.Sedlex_cset
|
||||
module Unicode = Sedlex_ppx.Unicode
|
||||
|
||||
let test_versions = ("16.0.0", "17.0.0")
|
||||
let test_versions = ("15.0.0", "16.0.0")
|
||||
|
||||
let regressions =
|
||||
[ (* Example *)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
45
flake.lock
45
flake.lock
|
|
@ -1,45 +0,0 @@
|
|||
{
|
||||
"nodes": {
|
||||
"dragnpkgs": {
|
||||
"inputs": {
|
||||
"nixpkgs": "nixpkgs"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1783018382,
|
||||
"narHash": "sha256-Pw7GM1fh2AnQNCitswXTHPfsswiDnEjXPN17Ge8egz4=",
|
||||
"ref": "nixos-26.05",
|
||||
"rev": "085892ad486428b8e51b549539a5430f0c2da1a8",
|
||||
"revCount": 247,
|
||||
"type": "git",
|
||||
"url": "https://git.lain.faith/haskal/dragnpkgs.git"
|
||||
},
|
||||
"original": {
|
||||
"id": "dragnpkgs",
|
||||
"type": "indirect"
|
||||
}
|
||||
},
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1782847225,
|
||||
"narHash": "sha256-JC9PjqKYG9ve5U8aDOLQipp3+KLANBHUvGdLZlxzdKI=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "95ca1e203c0750115fd4a6f17d5a245dfe6b1edd",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"ref": "nixos-26.05",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"dragnpkgs": "dragnpkgs"
|
||||
}
|
||||
}
|
||||
},
|
||||
"root": "root",
|
||||
"version": 7
|
||||
}
|
||||
23
flake.nix
23
flake.nix
|
|
@ -1,23 +0,0 @@
|
|||
{
|
||||
description = "Flake for noslop-sedlex";
|
||||
|
||||
outputs = { self, dragnpkgs } @ inputs: dragnpkgs.lib.mkFlake {
|
||||
packages.default = { ocamlPackages }: ocamlPackages.callPackage ./package.nix {};
|
||||
|
||||
devShells.default = { ocamlPackages, stdenv, mkShell }: mkShell {
|
||||
packages = with ocamlPackages; [
|
||||
ocaml
|
||||
dune_3
|
||||
utop
|
||||
odoc
|
||||
alcotest
|
||||
ocamlformat
|
||||
] ++ (self.packages.${stdenv.hostPlatform.system}.default.propagatedBuildInputs)
|
||||
++ (self.packages.${stdenv.hostPlatform.system}.default.nativeBuildInputs);
|
||||
|
||||
shellHook = ''
|
||||
export OCAMLRUNPARAM=b
|
||||
'';
|
||||
};
|
||||
};
|
||||
}
|
||||
|
|
@ -1,22 +0,0 @@
|
|||
The MIT License (MIT)
|
||||
|
||||
Copyright 2005, 2014 by Alain Frisch and LexiFi.
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
52
package.nix
52
package.nix
|
|
@ -1,52 +0,0 @@
|
|||
{
|
||||
lib,
|
||||
fetchurl,
|
||||
buildDunePackage,
|
||||
gen,
|
||||
ppxlib,
|
||||
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
|
||||
];
|
||||
|
||||
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;
|
||||
})
|
||||
|
|
@ -1,20 +1,23 @@
|
|||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
version: "3.7"
|
||||
version: "3.6"
|
||||
synopsis: "An OCaml lexer generator for Unicode"
|
||||
description: """
|
||||
sedlex is a lexer generator for OCaml. It is similar to ocamllex, but supports
|
||||
Unicode. Unlike ocamllex, sedlex allows lexer specifications within regular
|
||||
OCaml source files. Lexing specific constructs are provided via a ppx syntax
|
||||
extension."""
|
||||
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"
|
||||
maintainer: ["Alain Frisch <alain.frisch@lexifi.com>"]
|
||||
authors: [
|
||||
"Alain Frisch <alain.frisch@lexifi.com>"
|
||||
"https://github.com/ocaml-community/sedlex/graphs/contributors"
|
||||
]
|
||||
license: "MIT"
|
||||
homepage: "https://github.com/ocaml-community/sedlex"
|
||||
bug-reports: "https://github.com/ocaml-community/sedlex/issues"
|
||||
depends: [
|
||||
"ocaml" {>= "4.08"}
|
||||
"dune" {>= "3.20"}
|
||||
"dune" {>= "3.0"}
|
||||
"ppxlib" {>= "0.26.0"}
|
||||
"gen"
|
||||
"ppx_expect" {with-test}
|
||||
|
|
@ -34,5 +37,5 @@ build: [
|
|||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
dev-repo: "https://git.lain.faith/noslop/noslop-sedlex.git"
|
||||
x-maintenance-intent: ["(latest)"]
|
||||
dev-repo: "git+https://github.com/ocaml-community/sedlex.git"
|
||||
doc: "https://ocaml-community.github.io/sedlex/index.html"
|
||||
|
|
@ -0,0 +1 @@
|
|||
doc: "https://ocaml-community.github.io/sedlex/index.html"
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
(library
|
||||
(name sedlex_utils)
|
||||
(public_name noslop-sedlex.utils))
|
||||
(public_name sedlex.utils))
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
https://www.unicode.org/Public/17.0.0
|
||||
https://www.unicode.org/Public/16.0.0
|
||||
|
|
@ -1,3 +1,3 @@
|
|||
(executable
|
||||
(name gen_unicode)
|
||||
(libraries str noslop-sedlex.utils))
|
||||
(libraries str sedlex.utils))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
(library
|
||||
(name sedlex)
|
||||
(public_name noslop-sedlex)
|
||||
(public_name sedlex)
|
||||
(wrapped false)
|
||||
(libraries gen))
|
||||
(libraries gen)
|
||||
(flags :standard -w +A-4-9 -safe-string))
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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]. *)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,13 @@
|
|||
(library
|
||||
(name sedlex_ppx)
|
||||
(public_name noslop-sedlex.ppx)
|
||||
(public_name sedlex.ppx)
|
||||
(kind ppx_rewriter)
|
||||
(libraries ppxlib noslop-sedlex noslop-sedlex.utils)
|
||||
(ppx_runtime_libraries noslop-sedlex)
|
||||
(libraries ppxlib sedlex sedlex.utils)
|
||||
(ppx_runtime_libraries sedlex)
|
||||
(preprocess
|
||||
(pps ppxlib.metaquot)))
|
||||
(pps ppxlib.metaquot))
|
||||
(flags
|
||||
(:standard -w -9)))
|
||||
|
||||
(rule
|
||||
(targets unicode.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]; _ } ->
|
||||
begin match func (aux ~encoding p0) (aux ~encoding p1) with
|
||||
| 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
|
||||
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,12 +377,10 @@ let regexp_of_pattern env =
|
|||
{
|
||||
ppat_desc =
|
||||
Ppat_constant (i1 as i2) | Ppat_interval (i1, i2);
|
||||
_;
|
||||
};
|
||||
];
|
||||
_;
|
||||
} ) ) ->
|
||||
begin match (i1, i2) with
|
||||
} ) ) -> begin
|
||||
match (i1, i2) with
|
||||
| Pconst_integer (i1, _), Pconst_integer (i2, _) ->
|
||||
let i1 = int_of_string i1 in
|
||||
let i2 = int_of_string i2 in
|
||||
|
|
@ -383,33 +388,33 @@ let regexp_of_pattern env =
|
|||
else err p.ppat_loc "Invalid range for Rep operator"
|
||||
| _ ->
|
||||
err p.ppat_loc "Rep must take an integer constant or interval"
|
||||
end
|
||||
| Ppat_construct ({ txt = Lident "Rep"; _ }, _) ->
|
||||
end
|
||||
| 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) ->
|
||||
begin match arg with
|
||||
| Some (_, p0) ->
|
||||
begin match Sedlex.compl (aux ~encoding p0) with
|
||||
| Ppat_construct ({ txt = Lident "Compl" }, arg) -> begin
|
||||
match arg with
|
||||
| Some (_, p0) -> begin
|
||||
match Sedlex.compl (aux ~encoding p0) with
|
||||
| Some r -> r
|
||||
| None ->
|
||||
err p.ppat_loc
|
||||
"the Compl operator can only applied to a \
|
||||
single-character length regexp"
|
||||
end
|
||||
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
|
||||
end
|
||||
| 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
|
||||
|
|
@ -419,8 +424,8 @@ let regexp_of_pattern env =
|
|||
Sedlex.chars chars
|
||||
| _ ->
|
||||
err p.ppat_loc "the Chars operator requires a string argument")
|
||||
| Ppat_interval (i_start, i_end) ->
|
||||
begin match (i_start, i_end) with
|
||||
| Ppat_interval (i_start, i_end) -> begin
|
||||
match (i_start, i_end) with
|
||||
| Pconst_char c1, Pconst_char c2 ->
|
||||
let valid =
|
||||
match encoding with
|
||||
|
|
@ -441,9 +446,9 @@ let regexp_of_pattern env =
|
|||
(codepoint (int_of_string i1))
|
||||
(codepoint (int_of_string i2)))
|
||||
| _ -> err p.ppat_loc "this pattern is not a valid interval regexp"
|
||||
end
|
||||
| Ppat_constant const ->
|
||||
begin match const with
|
||||
end
|
||||
| Ppat_constant const -> begin
|
||||
match const with
|
||||
| Pconst_string (s, _, _) ->
|
||||
let rev_l = rev_csets_of_string s ~loc:p.ppat_loc ~encoding in
|
||||
List.fold_left
|
||||
|
|
@ -453,55 +458,15 @@ let regexp_of_pattern env =
|
|||
| Pconst_integer (i, _) ->
|
||||
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; _ } ->
|
||||
begin try StringMap.find x env
|
||||
end
|
||||
| Ppat_var { txt = x } -> begin
|
||||
try StringMap.find x env
|
||||
with Not_found -> err p.ppat_loc "unbound regexp %s" x
|
||||
end
|
||||
end
|
||||
| _ -> err p.ppat_loc "this pattern is not a valid regexp"
|
||||
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 -> []
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -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)))
|
||||
|
|
@ -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 -> () | _ -> ())
|
||||
|}]
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
(library
|
||||
(name sedlex_test)
|
||||
(libraries noslop-sedlex)
|
||||
(libraries sedlex)
|
||||
(inline_tests
|
||||
(deps UTF-8-test.txt))
|
||||
(enabled_if
|
||||
(>= %{ocaml_version} 4.14))
|
||||
(preprocess
|
||||
(pps noslop-sedlex.ppx ppx_expect)))
|
||||
(pps sedlex.ppx ppx_expect)))
|
||||
|
|
|
|||
|
|
@ -1,6 +0,0 @@
|
|||
(library
|
||||
(name ppx_sedlex_test)
|
||||
(kind ppx_rewriter)
|
||||
(libraries ppxlib noslop-sedlex.ppx)
|
||||
(preprocess
|
||||
(pps ppxlib.metaquot)))
|
||||
|
|
@ -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]
|
||||
Loading…
Reference in New Issue