From d76dd776bf93ef65a3d301ed4b54f6a08742241a Mon Sep 17 00:00:00 2001 From: Tianyi Song Date: Thu, 22 Aug 2024 09:18:33 +0000 Subject: [PATCH 001/109] Add callback adaptor for external parser --- src/html_tokenizer.ml | 18 ++++++++++++------ src/html_tokenizer.mli | 9 +++++++-- src/markup.ml | 13 ++++++++++++- src/markup.mli | 7 +++++++ 4 files changed, 38 insertions(+), 9 deletions(-) diff --git a/src/html_tokenizer.ml b/src/html_tokenizer.ml index d89c7a0..e54f7c2 100644 --- a/src/html_tokenizer.ml +++ b/src/html_tokenizer.ml @@ -1536,13 +1536,12 @@ module Ragel = struct let inner = HS.Raw.project raw in try Web.htmldecode inner with _ -> inner - let tokenize html = - let ctx = HS.init () in + let proc ~ctx = let tokens = ref [] in let tuck_with_location ~ctx token = tuck tokens ((HS.get_lnum ctx, -1), token) in - let call = function + let step = function | HS.Text raw -> tuck_with_location ~ctx (`String (decode raw)) | Tag (name, attrs) -> tuck_with_location ~ctx @@ -1584,8 +1583,15 @@ module Ragel = struct tuck_with_location ~ctx (`End { name = "style"; attributes = []; self_closing = false }) in + let fin () = + tuck_with_location ~ctx `EOF; + Kstream.of_list (List.rev !tokens) + in + (step, fin) - let () = HS.parse ~ctx call html in - tuck_with_location ~ctx `EOF; - Kstream.of_list (List.rev !tokens) + let tokenize html = + let ctx = HS.init () in + let (step, fin) = proc ~ctx in + let () = HS.parse ~ctx step html in + fin () end diff --git a/src/html_tokenizer.mli b/src/html_tokenizer.mli index 78e064e..ed28af8 100644 --- a/src/html_tokenizer.mli +++ b/src/html_tokenizer.mli @@ -23,5 +23,10 @@ val tokenize : module Ragel : sig - val tokenize : string -> (location * token) Kstream.t -end \ No newline at end of file + val proc : + ctx:Devkit.HtmlStream.ctx -> + ((Devkit.HtmlStream.elem -> unit) * + (unit -> (location * token) Kstream.t)) + + val tokenize : string -> (location * token) Kstream.t +end diff --git a/src/markup.ml b/src/markup.ml index 15bc2ef..2a591e0 100644 --- a/src/markup.ml +++ b/src/markup.ml @@ -103,6 +103,14 @@ module Cps = struct let signals = Html_parser.parse ?depth_limit context report (tokens, ignore, ignore) in stream_to_parser signals + let parse_html_proc ~ctx ?depth_limit report context = + let (step, fin) = Html_tokenizer.Ragel.proc ~ctx in + let fin () = + let tokens = fin () in + let signals = Html_parser.parse ?depth_limit context report (tokens, ignore, ignore) in stream_to_parser signals + in + (step, fin) + let parse_html report ?depth_limit ?encoding context source = let with_encoding (encoding : Encoding.t) k = source |> encoding ~report @@ -119,7 +127,6 @@ module Cps = struct Detect.select_html source throw (fun encoding -> with_encoding encoding k) in - Kstream.construct constructor |> stream_to_parser let write_html ?escape_attribute ?escape_text signals = @@ -249,6 +256,10 @@ module Asynchronous (IO : IO) = struct let parse_html_ragel ?(report = fun _ _ -> IO.return ()) ?context ?depth_limit source = Cps.parse_html_ragel ?depth_limit (wrap_report report) context source + (* callback into [TagStream.scan_ragel] *) + let parse_html_proc ?(report = fun _ _ -> IO.return ()) ?context ?depth_limit ~ctx () = + Cps.parse_html_proc ?depth_limit ~ctx (wrap_report report) context + let write_html ?escape_attribute ?escape_text signals = Cps.write_html ?escape_attribute ?escape_text signals diff --git a/src/markup.mli b/src/markup.mli index c123404..8af9ab6 100644 --- a/src/markup.mli +++ b/src/markup.mli @@ -375,6 +375,13 @@ val parse_html_ragel : ?depth_limit:int -> string -> 's parser +val parse_html_proc : + ?report:(location -> Error.t -> unit) -> + ?context:[< `Document | `Fragment of string ] -> + ?depth_limit:int -> + ctx:Devkit.HtmlStream.ctx -> + unit -> ((Devkit.HtmlStream.elem -> unit) * (unit -> 's parser)) + val parse_html : ?report:(location -> Error.t -> unit) -> ?encoding:Encoding.t -> From dc3725fb5ea300a40c449229bc12d809fc45e2fb Mon Sep 17 00:00:00 2001 From: Tianyi Song Date: Thu, 29 Aug 2024 03:52:07 +0000 Subject: [PATCH 002/109] Remove Ragel-specific code and expose internals --- src/html_tokenizer.ml | 68 ------------------------------------------ src/html_tokenizer.mli | 10 ------- src/markup.ml | 33 ++++++++++---------- src/markup.mli | 40 +++++++++++++++++-------- 4 files changed, 44 insertions(+), 107 deletions(-) diff --git a/src/html_tokenizer.ml b/src/html_tokenizer.ml index e54f7c2..b00efd3 100644 --- a/src/html_tokenizer.ml +++ b/src/html_tokenizer.ml @@ -1527,71 +1527,3 @@ let tokenize report (input, get_location) = let set_foreign = ( := ) foreign in (stream, set_state, set_foreign) - -module Ragel = struct - open Devkit - module HS = HtmlStream - - let decode raw = - let inner = HS.Raw.project raw in - try Web.htmldecode inner with _ -> inner - - let proc ~ctx = - let tokens = ref [] in - let tuck_with_location ~ctx token = - tuck tokens ((HS.get_lnum ctx, -1), token) - in - let step = function - | HS.Text raw -> tuck_with_location ~ctx (`String (decode raw)) - | Tag (name, attrs) -> - tuck_with_location ~ctx - (`Start - { - name; - attributes = List.rev_map (fun (k, v) -> (k, decode v)) attrs; - (* TODO: HS calls close tag immediately after open tag if tag is self closing; check if don't distinguish it changes anything *) - self_closing = false; - }) - | Close "br" -> - (* given
, HS genrates Tag ("br", ..) and Close "br", - but on the latter parser will detect unmatched end tag and insert opening, causing double
*) - () - | Close name -> - tuck_with_location ~ctx - (`End { name; attributes = []; self_closing = false }) - | Script (attrs, inner) -> - (* TODO: see if can remove these *) - tuck_with_location ~ctx - (`Start - { - name = "script"; - attributes = List.rev_map (fun (k, v) -> (k, decode v)) attrs; - self_closing = false; - }); - tuck_with_location ~ctx (`String (inner)); - tuck_with_location ~ctx - (`End { name = "script"; attributes = []; self_closing = false }) - | Style (attrs, inner) -> - tuck_with_location ~ctx - (`Start - { - name = "style"; - attributes = List.rev_map (fun (k, v) -> (k, decode v)) attrs; - self_closing = false; - }); - tuck_with_location ~ctx (`String (inner)); - tuck_with_location ~ctx - (`End { name = "style"; attributes = []; self_closing = false }) - in - let fin () = - tuck_with_location ~ctx `EOF; - Kstream.of_list (List.rev !tokens) - in - (step, fin) - - let tokenize html = - let ctx = HS.init () in - let (step, fin) = proc ~ctx in - let () = HS.parse ~ctx step html in - fin () -end diff --git a/src/html_tokenizer.mli b/src/html_tokenizer.mli index ed28af8..7bf1c3f 100644 --- a/src/html_tokenizer.mli +++ b/src/html_tokenizer.mli @@ -20,13 +20,3 @@ val tokenize : (location * token) Kstream.t * (state -> unit) * ((unit -> bool) -> unit) - - -module Ragel : sig - val proc : - ctx:Devkit.HtmlStream.ctx -> - ((Devkit.HtmlStream.elem -> unit) * - (unit -> (location * token) Kstream.t)) - - val tokenize : string -> (location * token) Kstream.t -end diff --git a/src/markup.ml b/src/markup.ml index 2a591e0..ab4e1c3 100644 --- a/src/markup.ml +++ b/src/markup.ml @@ -98,18 +98,12 @@ module Cps = struct let write_xml report prefix signals = signals |> Xml_writer.write report prefix |> Utility.strings_to_bytes - let parse_html_ragel ?depth_limit report context source = - let tokens = Html_tokenizer.Ragel.tokenize source in - let signals = Html_parser.parse ?depth_limit context report (tokens, ignore, ignore) in - stream_to_parser signals - - let parse_html_proc ~ctx ?depth_limit report context = - let (step, fin) = Html_tokenizer.Ragel.proc ~ctx in - let fin () = - let tokens = fin () in - let signals = Html_parser.parse ?depth_limit context report (tokens, ignore, ignore) in stream_to_parser signals + let parse_tokens ?depth_limit report context tokens = + let tokens = Kstream.of_list tokens in + let signals = + Html_parser.parse ?depth_limit context report (tokens, ignore, ignore) in - (step, fin) + stream_to_parser signals let parse_html report ?depth_limit ?encoding context source = let with_encoding (encoding : Encoding.t) k = @@ -253,12 +247,10 @@ module Asynchronous (IO : IO) = struct ?depth_limit source = Cps.parse_html (wrap_report report) ?depth_limit ?encoding context source - let parse_html_ragel ?(report = fun _ _ -> IO.return ()) ?context ?depth_limit source = - Cps.parse_html_ragel ?depth_limit (wrap_report report) context source - (* callback into [TagStream.scan_ragel] *) - let parse_html_proc ?(report = fun _ _ -> IO.return ()) ?context ?depth_limit ~ctx () = - Cps.parse_html_proc ?depth_limit ~ctx (wrap_report report) context + let parse_tokens ?(report = fun _ _ -> IO.return ()) ?context ?depth_limit + tokens = + Cps.parse_tokens ?depth_limit (wrap_report report) context tokens let write_html ?escape_attribute ?escape_text signals = Cps.write_html ?escape_attribute ?escape_text signals @@ -304,3 +296,12 @@ module Asynchronous (IO : IO) = struct end include Asynchronous (Synchronous) + +module Internals = struct + include Common + module Token_tag = Common.Token_tag + + type token = Html_tokenizer.token + + let parse_tokens = parse_tokens +end diff --git a/src/markup.mli b/src/markup.mli index 8af9ab6..89b1406 100644 --- a/src/markup.mli +++ b/src/markup.mli @@ -369,19 +369,6 @@ val write_xml : (** {2 HTML} *) -val parse_html_ragel : - ?report:(location -> Error.t -> unit) -> - ?context:[< `Document | `Fragment of string ] -> - ?depth_limit:int -> - string -> 's parser - -val parse_html_proc : - ?report:(location -> Error.t -> unit) -> - ?context:[< `Document | `Fragment of string ] -> - ?depth_limit:int -> - ctx:Devkit.HtmlStream.ctx -> - unit -> ((Devkit.HtmlStream.elem -> unit) * (unit -> 's parser)) - val parse_html : ?report:(location -> Error.t -> unit) -> ?encoding:Encoding.t -> @@ -982,3 +969,30 @@ val preprocess_input_stream : - HTML: [] tags found in the body do not have their attributes added to the [`Start_element "html"] signal emitted at the beginning of the document. *) + +(* Exposing some internal types and functions to allow sane integration *) +module Internals : sig + type location = int * int + + module Token_tag : sig + type t = + {name : string; + attributes : (string * string) list; + self_closing : bool} + end + + type token = + [ `Doctype of doctype + | `Start of Token_tag.t + | `End of Token_tag.t + | `Char of int + | `String of string + | `Comment of string + | `EOF ] + + val parse_tokens : + ?report:(location -> Error.t -> unit) -> + ?context:[< `Document | `Fragment of string ] -> + ?depth_limit:int -> + (location * token) list -> 's parser +end From f9e55e22106c085ccb64719468ee69d260c153a6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 13:09:13 -0400 Subject: [PATCH 003/109] create markup.common this will be shared with upcoming markup.tiny --- Makefile | 6 +- src/common.ml | 115 +- src/common/common.ml | 101 + src/common/dune | 9 + src/common/error.ml | 69 + src/common/error.mli | 15 + src/common/kstream.ml | 134 + src/{ => common}/kstream.mli | 3 +- src/common/markup_common.ml | 43 + src/common/markup_common.mli | 74 + src/common/stream.ml | 11 + src/common/stream.mli | 24 + src/dune | 2 +- src/entities.ml | 2241 +---------------- src/entities/dune | 8 + src/{ => entities}/entities.json | 0 src/entities/entities.ml | 2239 ++++++++++++++++ src/entities/markup_entities.ml | 9 + src/{ => entities}/translate_entities/dune | 0 .../translate_entities/translate_entities.ml | 2 +- src/entities/trie.ml | 79 + src/error.ml | 69 +- src/kstream.ml | 131 +- src/markup.ml | 118 +- src/markup.mli | 20 +- src/trie.ml | 77 +- 26 files changed, 2954 insertions(+), 2645 deletions(-) create mode 100644 src/common/common.ml create mode 100644 src/common/dune create mode 100644 src/common/error.ml create mode 100644 src/common/error.mli create mode 100644 src/common/kstream.ml rename src/{ => common}/kstream.mli (96%) create mode 100644 src/common/markup_common.ml create mode 100644 src/common/markup_common.mli create mode 100644 src/common/stream.ml create mode 100644 src/common/stream.mli create mode 100644 src/entities/dune rename src/{ => entities}/entities.json (100%) create mode 100644 src/entities/entities.ml create mode 100644 src/entities/markup_entities.ml rename src/{ => entities}/translate_entities/dune (100%) rename src/{ => entities}/translate_entities/translate_entities.ml (96%) create mode 100644 src/entities/trie.ml diff --git a/Makefile b/Makefile index 183a70b..f818e9a 100644 --- a/Makefile +++ b/Makefile @@ -6,8 +6,8 @@ build : # is checked into git. .PHONY : entities entities : - dune exec src/translate_entities/translate_entities.exe \ - > src/entities.ml + dune exec src/entities/translate_entities/translate_entities.exe \ + > src/entities/entities.ml .PHONY : test test : @@ -17,7 +17,7 @@ test : coverage : find . -name '*.coverage' | xargs rm -f dune runtest --instrument-with bisect_ppx --force - bisect-ppx-report html --expect src/ --do-not-expect src/translate_entities/ + bisect-ppx-report html --expect src/ --do-not-expect src/entities/translate_entities/ bisect-ppx-report summary @echo See _coverage/index.html diff --git a/src/common.ml b/src/common.ml index faa36f0..7fd90ff 100644 --- a/src/common.ml +++ b/src/common.ml @@ -4,21 +4,18 @@ type 'a cont = 'a -> unit type 'a cps = exn cont -> 'a cont -> unit -type location = int * int +type location = Markup_common.location -let compare_locations (line, column) (line', column') = - match line - line' with - | 0 -> column - column' - | order -> order +let compare_locations = Markup_common.compare_locations -type name = string * string +type name = Markup_common.name -let xml_ns = "http://www.w3.org/XML/1998/namespace" -let xmlns_ns = "http://www.w3.org/2000/xmlns/" -let xlink_ns = "http://www.w3.org/1999/xlink" -let html_ns = "http://www.w3.org/1999/xhtml" -let svg_ns = "http://www.w3.org/2000/svg" -let mathml_ns = "http://www.w3.org/1998/Math/MathML" +let xml_ns = Markup_common.Ns.xml +let xmlns_ns = Markup_common.Ns.xmlns +let xlink_ns = Markup_common.Ns.xlink +let html_ns = Markup_common.Ns.html +let svg_ns = Markup_common.Ns.svg +let mathml_ns = Markup_common.Ns.mathml module Token_tag = struct @@ -28,26 +25,21 @@ struct self_closing : bool} end -type xml_declaration = - {version : string; - encoding : string option; - standalone : bool option} - -type doctype = - {doctype_name : string option; - public_identifier : string option; - system_identifier : string option; - raw_text : string option; - force_quirks : bool} - -type signal = - [ `Start_element of name * (name * string) list - | `End_element - | `Text of string list - | `Xml of xml_declaration - | `Doctype of doctype - | `PI of string * string - | `Comment of string ] +type xml_declaration = Markup_common.xml_declaration = { + version : string; + encoding : string option; + standalone : bool option; +} + +type doctype = Markup_common.doctype = { + doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool; +} + +type signal = Markup_common.signal type general_token = [ `Xml of xml_declaration @@ -147,64 +139,7 @@ let is_valid_xml_char c = || is_in_range 0xE000 0xFFFD c || is_in_range 0x10000 0x10FFFF c -let signal_to_string = function - | `Comment s -> - Printf.sprintf "" s - - | `Doctype d -> - let text = - match d.doctype_name with - | None -> - begin match d.raw_text with - | None -> "" - | Some s -> " " ^ s - end - | Some name -> - match d.public_identifier, d.system_identifier with - | None, None -> " " ^ name - | Some p, None -> Printf.sprintf " %s PUBLIC \"%s\"" name p - | None, Some s -> Printf.sprintf " %s SYSTEM \"%s\"" name s - | Some p, Some s -> Printf.sprintf " %s PUBLIC \"%s\" \"%s\"" name p s - in - Printf.sprintf "" text - - | `Start_element (name, attributes) -> - let name_to_string = function - | "", local_name -> local_name - | ns, local_name -> ns ^ ":" ^ local_name - in - let attributes = - attributes - |> List.map (fun (name, value) -> - Printf.sprintf " %s=\"%s\"" (name_to_string name) value) - |> String.concat "" - in - Printf.sprintf "<%s%s>" (name_to_string name) attributes - - | `End_element -> - "" - - | `Text ss -> - String.concat "" ss - - | `Xml x -> - let s = Printf.sprintf "" x.version in - let s = - match x.encoding with - | None -> s - | Some encoding -> Printf.sprintf "%s encoding=\"%s\"" s encoding - in - let s = - match x.standalone with - | None -> s - | Some standalone -> - Printf.sprintf - "%s standalone=\"%s\"" s (if standalone then "yes" else "no") - in - s ^ "?>" - - | `PI (target, s) -> - Printf.sprintf "" target s +let signal_to_string = Markup_common.signal_to_string let token_to_string = function | `Xml x -> diff --git a/src/common/common.ml b/src/common/common.ml new file mode 100644 index 0000000..bd6cc33 --- /dev/null +++ b/src/common/common.ml @@ -0,0 +1,101 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +type 'a cont = 'a -> unit +type 'a cps = exn cont -> 'a cont -> unit + +type location = int * int + +let compare_locations (line, column) (line', column') = + match line - line' with + | 0 -> column - column' + | order -> order + +type name = string * string + +let xml_ns = "http://www.w3.org/XML/1998/namespace" +let xmlns_ns = "http://www.w3.org/2000/xmlns/" +let xlink_ns = "http://www.w3.org/1999/xlink" +let html_ns = "http://www.w3.org/1999/xhtml" +let svg_ns = "http://www.w3.org/2000/svg" +let mathml_ns = "http://www.w3.org/1998/Math/MathML" + +type xml_declaration = + {version : string; + encoding : string option; + standalone : bool option} + +type doctype = + {doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool} + +type signal = + [ `Start_element of name * (name * string) list + | `End_element + | `Text of string list + | `Xml of xml_declaration + | `Doctype of doctype + | `PI of string * string + | `Comment of string ] + +let signal_to_string = function + | `Comment s -> + Printf.sprintf "" s + + | `Doctype d -> + let text = + match d.doctype_name with + | None -> + begin match d.raw_text with + | None -> "" + | Some s -> " " ^ s + end + | Some name -> + match d.public_identifier, d.system_identifier with + | None, None -> " " ^ name + | Some p, None -> Printf.sprintf " %s PUBLIC \"%s\"" name p + | None, Some s -> Printf.sprintf " %s SYSTEM \"%s\"" name s + | Some p, Some s -> Printf.sprintf " %s PUBLIC \"%s\" \"%s\"" name p s + in + Printf.sprintf "" text + + | `Start_element (name, attributes) -> + let name_to_string = function + | "", local_name -> local_name + | ns, local_name -> ns ^ ":" ^ local_name + in + let attributes = + attributes + |> List.map (fun (name, value) -> + Printf.sprintf " %s=\"%s\"" (name_to_string name) value) + |> String.concat "" + in + Printf.sprintf "<%s%s>" (name_to_string name) attributes + + | `End_element -> + "" + + | `Text ss -> + String.concat "" ss + + | `Xml x -> + let s = Printf.sprintf "" x.version in + let s = + match x.encoding with + | None -> s + | Some encoding -> Printf.sprintf "%s encoding=\"%s\"" s encoding + in + let s = + match x.standalone with + | None -> s + | Some standalone -> + Printf.sprintf + "%s standalone=\"%s\"" s (if standalone then "yes" else "no") + in + s ^ "?>" + + | `PI (target, s) -> + Printf.sprintf "" target s diff --git a/src/common/dune b/src/common/dune new file mode 100644 index 0000000..4939517 --- /dev/null +++ b/src/common/dune @@ -0,0 +1,9 @@ +(library + (name markup_common) + (public_name markup.common) + (synopsis "Shared signal, stream and error types for Markup.ml") + (instrumentation + (backend bisect_ppx)) + (private_modules common) + (flags + (:standard -w -9))) diff --git a/src/common/error.ml b/src/common/error.ml new file mode 100644 index 0000000..d03f02b --- /dev/null +++ b/src/common/error.ml @@ -0,0 +1,69 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +type t = + [ `Decoding_error of string * string + | `Bad_token of string * string * string + | `Unexpected_eoi of string + | `Bad_document of string + | `Unmatched_start_tag of string + | `Unmatched_end_tag of string + | `Bad_namespace of string + | `Misnested_tag of string * string * (string * string) list + | `Bad_content of string ] + +let explode_string s = + let rec iterate index acc = + if index >= String.length s then List.rev acc + else iterate (index + 1) (s.[index]::acc) + in + iterate 0 [] + +let to_string ?location error = + let fmt = Printf.sprintf in + + let message = + match error with + | `Decoding_error (bytes, encoding) -> + begin match String.length bytes with + | 0 -> + fmt "bad bytes for encoding '%s'" encoding + | 1 -> + fmt "bad byte '0x%02X' for encoding '%s'" (Char.code bytes.[0]) encoding + | _ -> + fmt "bad bytes '%s' for encoding '%s'" + (explode_string bytes + |> List.map Char.code + |> List.map (fmt "0x%02X") + |> String.concat " ") + encoding + end + + | `Bad_token (s, production, reason) -> + fmt "bad token '%s' in %s: %s" s production reason + + | `Unexpected_eoi in_ -> + fmt "unexpected end of input in %s" in_ + + | `Bad_document reason -> + fmt "bad document: %s" reason + + | `Unmatched_start_tag s -> + fmt "unmatched start tag '%s'" s + + | `Unmatched_end_tag s -> + fmt "unmatched end tag '%s'" s + + | `Bad_namespace s -> + fmt "unknown namespace '%s'" s + + | `Misnested_tag (s, in_, _attributes) -> + fmt "misnested tag: '%s' in '%s'" s in_ + + | `Bad_content s -> + fmt "bad content in '%s'" s + in + + match location with + | None -> message + | Some (line, column) -> fmt "line %i, column %i: %s" line column message diff --git a/src/common/error.mli b/src/common/error.mli new file mode 100644 index 0000000..887e422 --- /dev/null +++ b/src/common/error.mli @@ -0,0 +1,15 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +type t = + [ `Decoding_error of string * string + | `Bad_token of string * string * string + | `Unexpected_eoi of string + | `Bad_document of string + | `Unmatched_start_tag of string + | `Unmatched_end_tag of string + | `Bad_namespace of string + | `Misnested_tag of string * string * (string * string) list + | `Bad_content of string ] + +val to_string : ?location:int * int -> t -> string diff --git a/src/common/kstream.ml b/src/common/kstream.ml new file mode 100644 index 0000000..2cf4bb9 --- /dev/null +++ b/src/common/kstream.ml @@ -0,0 +1,134 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +type 'a cont = 'a Common.cont +type 'a cps = 'a Common.cps + +type 'a t = {mutable f : exn cont -> unit cont -> 'a cont -> unit} + +let make f = {f} + +let construct c = + let s = ref None in + (fun throw e k -> + match !s with + | None -> c throw (fun s' -> s := Some s'; s'.f throw e k) + | Some s' -> s'.f throw e k) + |> make + +let empty () = (fun _ e _ -> e ()) |> make + +let next {f} throw e k = f throw e k + +let next_option {f} throw k = f throw (fun () -> k None) (fun v -> k (Some v)) + +let next_expected {f} throw k = + f throw (fun () -> throw (Failure "stream empty")) k + +let next_n n s throw k = + if n < 0 then throw (Invalid_argument "n is negative") + else + let rec iterate acc = function + | 0 -> k (List.rev acc) + | n -> + next s throw + (fun () -> iterate acc 0) (fun v -> iterate (v::acc) (n - 1)) + in + + iterate [] n + +let push ({f} as s) v = s.f <- fun _ _ k -> s.f <- f; k v + +let push_option s = function + | None -> () + | Some v -> push s v + +let push_list ({f} as s) = function + | [] -> () + | vs -> + let remainder = ref vs in + s.f <- fun throw e k -> + match !remainder with + | [] -> s.f <- f; f throw e k + | v::vs -> remainder := vs; k v + +let peek s throw e k = next s throw e (fun v -> push s v; k v) + +let peek_option s throw k = + peek s throw (fun () -> k None) (fun v -> k (Some v)) + +let peek_expected s throw k = + peek s throw (fun () -> throw (Failure "stream empty")) k + +let peek_n n s throw k = next_n n s throw (fun vs -> push_list s vs; k vs) + +let tap g ({f} as s) = + (s.f <- fun throw e k -> f throw e (fun v -> g v; k v)); + fun () -> s.f <- f + +let checkpoint s = + let buffer = ref [] in + let s' = + (fun throw e k -> + s.f throw e (fun v -> buffer := v::!buffer; k v)) + |> make + in + let restore () = push_list s (List.rev !buffer) in + s', restore + +let transform f init s = + let current_acc = ref (Some init) in + let to_emit = ref [] in + let rec operate throw e k = + match !to_emit with + | v::more -> to_emit := more; k v + | [] -> + match !current_acc with + | None -> e () + | Some acc -> + next s throw e (fun v -> + f acc v throw (fun (vs, acc') -> + to_emit := vs; + current_acc := acc'; + operate throw e k)) + in + make operate + +let map f s = (fun throw e k -> next s throw e (fun v -> f v throw k)) |> make + +let rec fold f v s throw k = + next s throw + (fun () -> k v) + (fun v' -> f v v' throw (fun v'' -> fold f v'' s throw k)) + +let iter f s throw k = fold (fun () v throw k -> f v throw k) () s throw k + +let filter_map f s = + let rec emit throw e k = + next s throw e (fun v -> + f v throw (function + | None -> emit throw e k + | Some v -> k v)) + in + make emit + +let filter f s = + s |> filter_map (fun v throw k -> + f v throw (function + | true -> k (Some v) + | false -> k None)) + +let of_list l = + let l = ref l in + (fun _ e k -> + match !l with + | [] -> e () + | v::l' -> l := l'; k v) + |> make + +let to_list s throw k = + fold (fun l v _ k -> k (v::l)) [] s throw (fun l -> k (List.rev l)) + +let enumerate s = + let index = ref 0 in + s |> map (fun v _ k -> index := !index + 1; k ((!index - 1), v)) diff --git a/src/kstream.mli b/src/common/kstream.mli similarity index 96% rename from src/kstream.mli rename to src/common/kstream.mli index 19e52f6..44db9eb 100644 --- a/src/kstream.mli +++ b/src/common/kstream.mli @@ -15,7 +15,8 @@ interface of Markup.ml, and the internal code should be calling them only when it is statically provable that the functions will succeed. *) -open Common +type 'a cont = 'a -> unit +type 'a cps = exn cont -> 'a cont -> unit type 'a t diff --git a/src/common/markup_common.ml b/src/common/markup_common.ml new file mode 100644 index 0000000..decf81f --- /dev/null +++ b/src/common/markup_common.ml @@ -0,0 +1,43 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +module Kstream = Kstream +module Error = Error +module Stream = Stream + +type async = unit +type sync = unit +type ('a, 's) stream = ('a, 's) Stream.t + +type location = Common.location + +let compare_locations = Common.compare_locations + +type name = Common.name + +type xml_declaration = Common.xml_declaration = { + version : string; + encoding : string option; + standalone : bool option; +} + +type doctype = Common.doctype = { + doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool; +} + +type signal = Common.signal + +let signal_to_string = Common.signal_to_string + +module Ns = struct + let html = Common.html_ns + let svg = Common.svg_ns + let mathml = Common.mathml_ns + let xml = Common.xml_ns + let xmlns = Common.xmlns_ns + let xlink = Common.xlink_ns +end diff --git a/src/common/markup_common.mli b/src/common/markup_common.mli new file mode 100644 index 0000000..397cc8b --- /dev/null +++ b/src/common/markup_common.mli @@ -0,0 +1,74 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(** Types shared by the [markup] and [markup.tiny] libraries. + + Both libraries alias the types below, so that streams produced by one are + accepted directly by consumers written against the other. Nothing here is + intended to be used directly by applications; use [Markup] or + [Markup_tiny]. *) + +(** Internal stream implementation, exposed so that libraries built on top of + this one can construct the shared stream type. Not a stable interface. *) +module Kstream = Kstream +module Stream = Stream + +module Error = Error + +(** {2 Streams} *) + +type async +type sync +(** Phantom types for use with [('a, 's) stream] in place of ['s]. They are + distinct and abstract, so that a [sync] stream cannot be passed where an + [async] stream is expected, and vice versa. *) + +type ('a, 's) stream = ('a, 's) Stream.t +(** Streams of elements of type ['a]. The operations on streams are + {!Kstream}'s; see {!Stream.Private} for converting between a [Kstream.t] + and a [stream] at no cost. *) + +(** {2 Errors} *) + +type location = int * int + +val compare_locations : location -> location -> int + +(** {2 Signals} *) + +type name = string * string + +type xml_declaration = { + version : string; + encoding : string option; + standalone : bool option; +} + +type doctype = { + doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool; +} + +type signal = + [ `Start_element of name * (name * string) list + | `End_element + | `Text of string list + | `Xml of xml_declaration + | `Doctype of doctype + | `PI of string * string + | `Comment of string ] + +val signal_to_string : [< signal ] -> string + +(** Common namespace URIs. *) +module Ns : sig + val html : string + val svg : string + val mathml : string + val xml : string + val xmlns : string + val xlink : string +end diff --git a/src/common/stream.ml b/src/common/stream.ml new file mode 100644 index 0000000..94789fa --- /dev/null +++ b/src/common/stream.ml @@ -0,0 +1,11 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* The phantom parameter is deliberately absent from the representation. *) +type ('a, 's) t = 'a Kstream.t + +module Private = +struct + let to_stream s = s + let of_stream s = s +end diff --git a/src/common/stream.mli b/src/common/stream.mli new file mode 100644 index 0000000..4f5293b --- /dev/null +++ b/src/common/stream.mli @@ -0,0 +1,24 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* The stream type shared by the libraries built on markup.common. This module + is only the type; the operations on streams (in [Kstream]) remain private + to each library. + + [t] is abstract here, which is what makes the phantom parameter meaningful: + outside this library, [('a, sync) t] and [('a, async) t] cannot be shown + equal, so a synchronous stream cannot be passed where an asynchronous one is + expected, and vice versa. That abstraction is the only thing keeping the two + distinct outside this library. *) + +type ('a, 's) t + +module Private : +sig + (* The two identity conversions between a [Kstream.t] and a phantom-tagged + [Stream.t], exposed so that a library implementing streams on top of + [Kstream] can exchange streams with other such libraries at no cost. + Not a stable interface. *) + val to_stream : 'a Kstream.t -> ('a, 's) t + val of_stream : ('a, 's) t -> 'a Kstream.t +end diff --git a/src/dune b/src/dune index cb22a6a..5697f4c 100644 --- a/src/dune +++ b/src/dune @@ -4,7 +4,7 @@ (synopsis "Error-recovering functional HTML5 and XML parsers") (instrumentation (backend bisect_ppx)) - (libraries devkit uutf) + (libraries devkit uutf markup.common markup.entities) (flags (:standard -w -9))) diff --git a/src/entities.ml b/src/entities.ml index 6e5c298..d18a4a7 100644 --- a/src/entities.ml +++ b/src/entities.ml @@ -1,2239 +1,6 @@ -(* Copyright © 2014 W3C® (MIT, ERCIM, Keio, Beihang). This software or document - includes material copied from or derived from W3C Recommendation HTML5 - [https://www.w3.org/TR/2014/REC-html5-20141028/]. *) +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) -(* Generated automatically from entities.json. *) +(* The entity table lives in the markup.entities library. *) -let entities : (string * [ `One of int | `Two of int * int ]) array = [| - "Aacute", `One 0x000C1; - "Aacut", `One 0x000C1; - "aacute", `One 0x000E1; - "aacut", `One 0x000E1; - "Abreve", `One 0x00102; - "abreve", `One 0x00103; - "ac", `One 0x0223E; - "acd", `One 0x0223F; - "acE", `Two (0x0223E, 0x00333); - "Acirc", `One 0x000C2; - "Acir", `One 0x000C2; - "acirc", `One 0x000E2; - "acir", `One 0x000E2; - "acute", `One 0x000B4; - "acut", `One 0x000B4; - "Acy", `One 0x00410; - "acy", `One 0x00430; - "AElig", `One 0x000C6; - "AEli", `One 0x000C6; - "aelig", `One 0x000E6; - "aeli", `One 0x000E6; - "af", `One 0x02061; - "Afr", `One 0x1D504; - "afr", `One 0x1D51E; - "Agrave", `One 0x000C0; - "Agrav", `One 0x000C0; - "agrave", `One 0x000E0; - "agrav", `One 0x000E0; - "alefsym", `One 0x02135; - "aleph", `One 0x02135; - "Alpha", `One 0x00391; - "alpha", `One 0x003B1; - "Amacr", `One 0x00100; - "amacr", `One 0x00101; - "amalg", `One 0x02A3F; - "AMP", `One 0x00026; - "AM", `One 0x00026; - "amp", `One 0x00026; - "am", `One 0x00026; - "And", `One 0x02A53; - "and", `One 0x02227; - "andand", `One 0x02A55; - "andd", `One 0x02A5C; - "andslope", `One 0x02A58; - "andv", `One 0x02A5A; - "ang", `One 0x02220; - "ange", `One 0x029A4; - "angle", `One 0x02220; - "angmsd", `One 0x02221; - "angmsdaa", `One 0x029A8; - "angmsdab", `One 0x029A9; - "angmsdac", `One 0x029AA; - "angmsdad", `One 0x029AB; - "angmsdae", `One 0x029AC; - "angmsdaf", `One 0x029AD; - "angmsdag", `One 0x029AE; - "angmsdah", `One 0x029AF; - "angrt", `One 0x0221F; - "angrtvb", `One 0x022BE; - "angrtvbd", `One 0x0299D; - "angsph", `One 0x02222; - "angst", `One 0x000C5; - "angzarr", `One 0x0237C; - "Aogon", `One 0x00104; - "aogon", `One 0x00105; - "Aopf", `One 0x1D538; - "aopf", `One 0x1D552; - "ap", `One 0x02248; - "apacir", `One 0x02A6F; - "apE", `One 0x02A70; - "ape", `One 0x0224A; - "apid", `One 0x0224B; - "apos", `One 0x00027; - "ApplyFunction", `One 0x02061; - "approx", `One 0x02248; - "approxeq", `One 0x0224A; - "Aring", `One 0x000C5; - "Arin", `One 0x000C5; - "aring", `One 0x000E5; - "arin", `One 0x000E5; - "Ascr", `One 0x1D49C; - "ascr", `One 0x1D4B6; - "Assign", `One 0x02254; - "ast", `One 0x0002A; - "asymp", `One 0x02248; - "asympeq", `One 0x0224D; - "Atilde", `One 0x000C3; - "Atild", `One 0x000C3; - "atilde", `One 0x000E3; - "atild", `One 0x000E3; - "Auml", `One 0x000C4; - "Aum", `One 0x000C4; - "auml", `One 0x000E4; - "aum", `One 0x000E4; - "awconint", `One 0x02233; - "awint", `One 0x02A11; - "backcong", `One 0x0224C; - "backepsilon", `One 0x003F6; - "backprime", `One 0x02035; - "backsim", `One 0x0223D; - "backsimeq", `One 0x022CD; - "Backslash", `One 0x02216; - "Barv", `One 0x02AE7; - "barvee", `One 0x022BD; - "Barwed", `One 0x02306; - "barwed", `One 0x02305; - "barwedge", `One 0x02305; - "bbrk", `One 0x023B5; - "bbrktbrk", `One 0x023B6; - "bcong", `One 0x0224C; - "Bcy", `One 0x00411; - "bcy", `One 0x00431; - "bdquo", `One 0x0201E; - "becaus", `One 0x02235; - "Because", `One 0x02235; - "because", `One 0x02235; - "bemptyv", `One 0x029B0; - "bepsi", `One 0x003F6; - "bernou", `One 0x0212C; - "Bernoullis", `One 0x0212C; - "Beta", `One 0x00392; - "beta", `One 0x003B2; - "beth", `One 0x02136; - "between", `One 0x0226C; - "Bfr", `One 0x1D505; - "bfr", `One 0x1D51F; - "bigcap", `One 0x022C2; - "bigcirc", `One 0x025EF; - "bigcup", `One 0x022C3; - "bigodot", `One 0x02A00; - "bigoplus", `One 0x02A01; - "bigotimes", `One 0x02A02; - "bigsqcup", `One 0x02A06; - "bigstar", `One 0x02605; - "bigtriangledown", `One 0x025BD; - "bigtriangleup", `One 0x025B3; - "biguplus", `One 0x02A04; - "bigvee", `One 0x022C1; - "bigwedge", `One 0x022C0; - "bkarow", `One 0x0290D; - "blacklozenge", `One 0x029EB; - "blacksquare", `One 0x025AA; - "blacktriangle", `One 0x025B4; - "blacktriangledown", `One 0x025BE; - "blacktriangleleft", `One 0x025C2; - "blacktriangleright", `One 0x025B8; - "blank", `One 0x02423; - "blk12", `One 0x02592; - "blk14", `One 0x02591; - "blk34", `One 0x02593; - "block", `One 0x02588; - "bne", `Two (0x0003D, 0x020E5); - "bnequiv", `Two (0x02261, 0x020E5); - "bNot", `One 0x02AED; - "bnot", `One 0x02310; - "Bopf", `One 0x1D539; - "bopf", `One 0x1D553; - "bot", `One 0x022A5; - "bottom", `One 0x022A5; - "bowtie", `One 0x022C8; - "boxbox", `One 0x029C9; - "boxDL", `One 0x02557; - "boxDl", `One 0x02556; - "boxdL", `One 0x02555; - "boxdl", `One 0x02510; - "boxDR", `One 0x02554; - "boxDr", `One 0x02553; - "boxdR", `One 0x02552; - "boxdr", `One 0x0250C; - "boxH", `One 0x02550; - "boxh", `One 0x02500; - "boxHD", `One 0x02566; - "boxHd", `One 0x02564; - "boxhD", `One 0x02565; - "boxhd", `One 0x0252C; - "boxHU", `One 0x02569; - "boxHu", `One 0x02567; - "boxhU", `One 0x02568; - "boxhu", `One 0x02534; - "boxminus", `One 0x0229F; - "boxplus", `One 0x0229E; - "boxtimes", `One 0x022A0; - "boxUL", `One 0x0255D; - "boxUl", `One 0x0255C; - "boxuL", `One 0x0255B; - "boxul", `One 0x02518; - "boxUR", `One 0x0255A; - "boxUr", `One 0x02559; - "boxuR", `One 0x02558; - "boxur", `One 0x02514; - "boxV", `One 0x02551; - "boxv", `One 0x02502; - "boxVH", `One 0x0256C; - "boxVh", `One 0x0256B; - "boxvH", `One 0x0256A; - "boxvh", `One 0x0253C; - "boxVL", `One 0x02563; - "boxVl", `One 0x02562; - "boxvL", `One 0x02561; - "boxvl", `One 0x02524; - "boxVR", `One 0x02560; - "boxVr", `One 0x0255F; - "boxvR", `One 0x0255E; - "boxvr", `One 0x0251C; - "bprime", `One 0x02035; - "Breve", `One 0x002D8; - "breve", `One 0x002D8; - "brvbar", `One 0x000A6; - "brvba", `One 0x000A6; - "Bscr", `One 0x0212C; - "bscr", `One 0x1D4B7; - "bsemi", `One 0x0204F; - "bsim", `One 0x0223D; - "bsime", `One 0x022CD; - "bsol", `One 0x0005C; - "bsolb", `One 0x029C5; - "bsolhsub", `One 0x027C8; - "bull", `One 0x02022; - "bullet", `One 0x02022; - "bump", `One 0x0224E; - "bumpE", `One 0x02AAE; - "bumpe", `One 0x0224F; - "Bumpeq", `One 0x0224E; - "bumpeq", `One 0x0224F; - "Cacute", `One 0x00106; - "cacute", `One 0x00107; - "Cap", `One 0x022D2; - "cap", `One 0x02229; - "capand", `One 0x02A44; - "capbrcup", `One 0x02A49; - "capcap", `One 0x02A4B; - "capcup", `One 0x02A47; - "capdot", `One 0x02A40; - "CapitalDifferentialD", `One 0x02145; - "caps", `Two (0x02229, 0x0FE00); - "caret", `One 0x02041; - "caron", `One 0x002C7; - "Cayleys", `One 0x0212D; - "ccaps", `One 0x02A4D; - "Ccaron", `One 0x0010C; - "ccaron", `One 0x0010D; - "Ccedil", `One 0x000C7; - "Ccedi", `One 0x000C7; - "ccedil", `One 0x000E7; - "ccedi", `One 0x000E7; - "Ccirc", `One 0x00108; - "ccirc", `One 0x00109; - "Cconint", `One 0x02230; - "ccups", `One 0x02A4C; - "ccupssm", `One 0x02A50; - "Cdot", `One 0x0010A; - "cdot", `One 0x0010B; - "cedil", `One 0x000B8; - "cedi", `One 0x000B8; - "Cedilla", `One 0x000B8; - "cemptyv", `One 0x029B2; - "cent", `One 0x000A2; - "cen", `One 0x000A2; - "CenterDot", `One 0x000B7; - "centerdot", `One 0x000B7; - "Cfr", `One 0x0212D; - "cfr", `One 0x1D520; - "CHcy", `One 0x00427; - "chcy", `One 0x00447; - "check", `One 0x02713; - "checkmark", `One 0x02713; - "Chi", `One 0x003A7; - "chi", `One 0x003C7; - "cir", `One 0x025CB; - "circ", `One 0x002C6; - "circeq", `One 0x02257; - "circlearrowleft", `One 0x021BA; - "circlearrowright", `One 0x021BB; - "circledast", `One 0x0229B; - "circledcirc", `One 0x0229A; - "circleddash", `One 0x0229D; - "CircleDot", `One 0x02299; - "circledR", `One 0x000AE; - "circledS", `One 0x024C8; - "CircleMinus", `One 0x02296; - "CirclePlus", `One 0x02295; - "CircleTimes", `One 0x02297; - "cirE", `One 0x029C3; - "cire", `One 0x02257; - "cirfnint", `One 0x02A10; - "cirmid", `One 0x02AEF; - "cirscir", `One 0x029C2; - "ClockwiseContourIntegral", `One 0x02232; - "CloseCurlyDoubleQuote", `One 0x0201D; - "CloseCurlyQuote", `One 0x02019; - "clubs", `One 0x02663; - "clubsuit", `One 0x02663; - "Colon", `One 0x02237; - "colon", `One 0x0003A; - "Colone", `One 0x02A74; - "colone", `One 0x02254; - "coloneq", `One 0x02254; - "comma", `One 0x0002C; - "commat", `One 0x00040; - "comp", `One 0x02201; - "compfn", `One 0x02218; - "complement", `One 0x02201; - "complexes", `One 0x02102; - "cong", `One 0x02245; - "congdot", `One 0x02A6D; - "Congruent", `One 0x02261; - "Conint", `One 0x0222F; - "conint", `One 0x0222E; - "ContourIntegral", `One 0x0222E; - "Copf", `One 0x02102; - "copf", `One 0x1D554; - "coprod", `One 0x02210; - "Coproduct", `One 0x02210; - "COPY", `One 0x000A9; - "COP", `One 0x000A9; - "copy", `One 0x000A9; - "cop", `One 0x000A9; - "copysr", `One 0x02117; - "CounterClockwiseContourIntegral", `One 0x02233; - "crarr", `One 0x021B5; - "Cross", `One 0x02A2F; - "cross", `One 0x02717; - "Cscr", `One 0x1D49E; - "cscr", `One 0x1D4B8; - "csub", `One 0x02ACF; - "csube", `One 0x02AD1; - "csup", `One 0x02AD0; - "csupe", `One 0x02AD2; - "ctdot", `One 0x022EF; - "cudarrl", `One 0x02938; - "cudarrr", `One 0x02935; - "cuepr", `One 0x022DE; - "cuesc", `One 0x022DF; - "cularr", `One 0x021B6; - "cularrp", `One 0x0293D; - "Cup", `One 0x022D3; - "cup", `One 0x0222A; - "cupbrcap", `One 0x02A48; - "CupCap", `One 0x0224D; - "cupcap", `One 0x02A46; - "cupcup", `One 0x02A4A; - "cupdot", `One 0x0228D; - "cupor", `One 0x02A45; - "cups", `Two (0x0222A, 0x0FE00); - "curarr", `One 0x021B7; - "curarrm", `One 0x0293C; - "curlyeqprec", `One 0x022DE; - "curlyeqsucc", `One 0x022DF; - "curlyvee", `One 0x022CE; - "curlywedge", `One 0x022CF; - "curren", `One 0x000A4; - "curre", `One 0x000A4; - "curvearrowleft", `One 0x021B6; - "curvearrowright", `One 0x021B7; - "cuvee", `One 0x022CE; - "cuwed", `One 0x022CF; - "cwconint", `One 0x02232; - "cwint", `One 0x02231; - "cylcty", `One 0x0232D; - "Dagger", `One 0x02021; - "dagger", `One 0x02020; - "daleth", `One 0x02138; - "Darr", `One 0x021A1; - "dArr", `One 0x021D3; - "darr", `One 0x02193; - "dash", `One 0x02010; - "Dashv", `One 0x02AE4; - "dashv", `One 0x022A3; - "dbkarow", `One 0x0290F; - "dblac", `One 0x002DD; - "Dcaron", `One 0x0010E; - "dcaron", `One 0x0010F; - "Dcy", `One 0x00414; - "dcy", `One 0x00434; - "DD", `One 0x02145; - "dd", `One 0x02146; - "ddagger", `One 0x02021; - "ddarr", `One 0x021CA; - "DDotrahd", `One 0x02911; - "ddotseq", `One 0x02A77; - "deg", `One 0x000B0; - "de", `One 0x000B0; - "Del", `One 0x02207; - "Delta", `One 0x00394; - "delta", `One 0x003B4; - "demptyv", `One 0x029B1; - "dfisht", `One 0x0297F; - "Dfr", `One 0x1D507; - "dfr", `One 0x1D521; - "dHar", `One 0x02965; - "dharl", `One 0x021C3; - "dharr", `One 0x021C2; - "DiacriticalAcute", `One 0x000B4; - "DiacriticalDot", `One 0x002D9; - "DiacriticalDoubleAcute", `One 0x002DD; - "DiacriticalGrave", `One 0x00060; - "DiacriticalTilde", `One 0x002DC; - "diam", `One 0x022C4; - "Diamond", `One 0x022C4; - "diamond", `One 0x022C4; - "diamondsuit", `One 0x02666; - "diams", `One 0x02666; - "die", `One 0x000A8; - "DifferentialD", `One 0x02146; - "digamma", `One 0x003DD; - "disin", `One 0x022F2; - "div", `One 0x000F7; - "divide", `One 0x000F7; - "divid", `One 0x000F7; - "divideontimes", `One 0x022C7; - "divonx", `One 0x022C7; - "DJcy", `One 0x00402; - "djcy", `One 0x00452; - "dlcorn", `One 0x0231E; - "dlcrop", `One 0x0230D; - "dollar", `One 0x00024; - "Dopf", `One 0x1D53B; - "dopf", `One 0x1D555; - "Dot", `One 0x000A8; - "dot", `One 0x002D9; - "DotDot", `One 0x020DC; - "doteq", `One 0x02250; - "doteqdot", `One 0x02251; - "DotEqual", `One 0x02250; - "dotminus", `One 0x02238; - "dotplus", `One 0x02214; - "dotsquare", `One 0x022A1; - "doublebarwedge", `One 0x02306; - "DoubleContourIntegral", `One 0x0222F; - "DoubleDot", `One 0x000A8; - "DoubleDownArrow", `One 0x021D3; - "DoubleLeftArrow", `One 0x021D0; - "DoubleLeftRightArrow", `One 0x021D4; - "DoubleLeftTee", `One 0x02AE4; - "DoubleLongLeftArrow", `One 0x027F8; - "DoubleLongLeftRightArrow", `One 0x027FA; - "DoubleLongRightArrow", `One 0x027F9; - "DoubleRightArrow", `One 0x021D2; - "DoubleRightTee", `One 0x022A8; - "DoubleUpArrow", `One 0x021D1; - "DoubleUpDownArrow", `One 0x021D5; - "DoubleVerticalBar", `One 0x02225; - "DownArrow", `One 0x02193; - "Downarrow", `One 0x021D3; - "downarrow", `One 0x02193; - "DownArrowBar", `One 0x02913; - "DownArrowUpArrow", `One 0x021F5; - "DownBreve", `One 0x00311; - "downdownarrows", `One 0x021CA; - "downharpoonleft", `One 0x021C3; - "downharpoonright", `One 0x021C2; - "DownLeftRightVector", `One 0x02950; - "DownLeftTeeVector", `One 0x0295E; - "DownLeftVector", `One 0x021BD; - "DownLeftVectorBar", `One 0x02956; - "DownRightTeeVector", `One 0x0295F; - "DownRightVector", `One 0x021C1; - "DownRightVectorBar", `One 0x02957; - "DownTee", `One 0x022A4; - "DownTeeArrow", `One 0x021A7; - "drbkarow", `One 0x02910; - "drcorn", `One 0x0231F; - "drcrop", `One 0x0230C; - "Dscr", `One 0x1D49F; - "dscr", `One 0x1D4B9; - "DScy", `One 0x00405; - "dscy", `One 0x00455; - "dsol", `One 0x029F6; - "Dstrok", `One 0x00110; - "dstrok", `One 0x00111; - "dtdot", `One 0x022F1; - "dtri", `One 0x025BF; - "dtrif", `One 0x025BE; - "duarr", `One 0x021F5; - "duhar", `One 0x0296F; - "dwangle", `One 0x029A6; - "DZcy", `One 0x0040F; - "dzcy", `One 0x0045F; - "dzigrarr", `One 0x027FF; - "Eacute", `One 0x000C9; - "Eacut", `One 0x000C9; - "eacute", `One 0x000E9; - "eacut", `One 0x000E9; - "easter", `One 0x02A6E; - "Ecaron", `One 0x0011A; - "ecaron", `One 0x0011B; - "ecir", `One 0x02256; - "Ecirc", `One 0x000CA; - "Ecir", `One 0x000CA; - "ecirc", `One 0x000EA; - "ecir", `One 0x000EA; - "ecolon", `One 0x02255; - "Ecy", `One 0x0042D; - "ecy", `One 0x0044D; - "eDDot", `One 0x02A77; - "Edot", `One 0x00116; - "eDot", `One 0x02251; - "edot", `One 0x00117; - "ee", `One 0x02147; - "efDot", `One 0x02252; - "Efr", `One 0x1D508; - "efr", `One 0x1D522; - "eg", `One 0x02A9A; - "Egrave", `One 0x000C8; - "Egrav", `One 0x000C8; - "egrave", `One 0x000E8; - "egrav", `One 0x000E8; - "egs", `One 0x02A96; - "egsdot", `One 0x02A98; - "el", `One 0x02A99; - "Element", `One 0x02208; - "elinters", `One 0x023E7; - "ell", `One 0x02113; - "els", `One 0x02A95; - "elsdot", `One 0x02A97; - "Emacr", `One 0x00112; - "emacr", `One 0x00113; - "empty", `One 0x02205; - "emptyset", `One 0x02205; - "EmptySmallSquare", `One 0x025FB; - "emptyv", `One 0x02205; - "EmptyVerySmallSquare", `One 0x025AB; - "emsp", `One 0x02003; - "emsp13", `One 0x02004; - "emsp14", `One 0x02005; - "ENG", `One 0x0014A; - "eng", `One 0x0014B; - "ensp", `One 0x02002; - "Eogon", `One 0x00118; - "eogon", `One 0x00119; - "Eopf", `One 0x1D53C; - "eopf", `One 0x1D556; - "epar", `One 0x022D5; - "eparsl", `One 0x029E3; - "eplus", `One 0x02A71; - "epsi", `One 0x003B5; - "Epsilon", `One 0x00395; - "epsilon", `One 0x003B5; - "epsiv", `One 0x003F5; - "eqcirc", `One 0x02256; - "eqcolon", `One 0x02255; - "eqsim", `One 0x02242; - "eqslantgtr", `One 0x02A96; - "eqslantless", `One 0x02A95; - "Equal", `One 0x02A75; - "equals", `One 0x0003D; - "EqualTilde", `One 0x02242; - "equest", `One 0x0225F; - "Equilibrium", `One 0x021CC; - "equiv", `One 0x02261; - "equivDD", `One 0x02A78; - "eqvparsl", `One 0x029E5; - "erarr", `One 0x02971; - "erDot", `One 0x02253; - "Escr", `One 0x02130; - "escr", `One 0x0212F; - "esdot", `One 0x02250; - "Esim", `One 0x02A73; - "esim", `One 0x02242; - "Eta", `One 0x00397; - "eta", `One 0x003B7; - "ETH", `One 0x000D0; - "ET", `One 0x000D0; - "eth", `One 0x000F0; - "et", `One 0x000F0; - "Euml", `One 0x000CB; - "Eum", `One 0x000CB; - "euml", `One 0x000EB; - "eum", `One 0x000EB; - "euro", `One 0x020AC; - "excl", `One 0x00021; - "exist", `One 0x02203; - "Exists", `One 0x02203; - "expectation", `One 0x02130; - "ExponentialE", `One 0x02147; - "exponentiale", `One 0x02147; - "fallingdotseq", `One 0x02252; - "Fcy", `One 0x00424; - "fcy", `One 0x00444; - "female", `One 0x02640; - "ffilig", `One 0x0FB03; - "fflig", `One 0x0FB00; - "ffllig", `One 0x0FB04; - "Ffr", `One 0x1D509; - "ffr", `One 0x1D523; - "filig", `One 0x0FB01; - "FilledSmallSquare", `One 0x025FC; - "FilledVerySmallSquare", `One 0x025AA; - "fjlig", `Two (0x00066, 0x0006A); - "flat", `One 0x0266D; - "fllig", `One 0x0FB02; - "fltns", `One 0x025B1; - "fnof", `One 0x00192; - "Fopf", `One 0x1D53D; - "fopf", `One 0x1D557; - "ForAll", `One 0x02200; - "forall", `One 0x02200; - "fork", `One 0x022D4; - "forkv", `One 0x02AD9; - "Fouriertrf", `One 0x02131; - "fpartint", `One 0x02A0D; - "frac12", `One 0x000BD; - "frac1", `One 0x000BD; - "frac13", `One 0x02153; - "frac14", `One 0x000BC; - "frac1", `One 0x000BC; - "frac15", `One 0x02155; - "frac16", `One 0x02159; - "frac18", `One 0x0215B; - "frac23", `One 0x02154; - "frac25", `One 0x02156; - "frac34", `One 0x000BE; - "frac3", `One 0x000BE; - "frac35", `One 0x02157; - "frac38", `One 0x0215C; - "frac45", `One 0x02158; - "frac56", `One 0x0215A; - "frac58", `One 0x0215D; - "frac78", `One 0x0215E; - "frasl", `One 0x02044; - "frown", `One 0x02322; - "Fscr", `One 0x02131; - "fscr", `One 0x1D4BB; - "gacute", `One 0x001F5; - "Gamma", `One 0x00393; - "gamma", `One 0x003B3; - "Gammad", `One 0x003DC; - "gammad", `One 0x003DD; - "gap", `One 0x02A86; - "Gbreve", `One 0x0011E; - "gbreve", `One 0x0011F; - "Gcedil", `One 0x00122; - "Gcirc", `One 0x0011C; - "gcirc", `One 0x0011D; - "Gcy", `One 0x00413; - "gcy", `One 0x00433; - "Gdot", `One 0x00120; - "gdot", `One 0x00121; - "gE", `One 0x02267; - "ge", `One 0x02265; - "gEl", `One 0x02A8C; - "gel", `One 0x022DB; - "geq", `One 0x02265; - "geqq", `One 0x02267; - "geqslant", `One 0x02A7E; - "ges", `One 0x02A7E; - "gescc", `One 0x02AA9; - "gesdot", `One 0x02A80; - "gesdoto", `One 0x02A82; - "gesdotol", `One 0x02A84; - "gesl", `Two (0x022DB, 0x0FE00); - "gesles", `One 0x02A94; - "Gfr", `One 0x1D50A; - "gfr", `One 0x1D524; - "Gg", `One 0x022D9; - "gg", `One 0x0226B; - "ggg", `One 0x022D9; - "gimel", `One 0x02137; - "GJcy", `One 0x00403; - "gjcy", `One 0x00453; - "gl", `One 0x02277; - "gla", `One 0x02AA5; - "glE", `One 0x02A92; - "glj", `One 0x02AA4; - "gnap", `One 0x02A8A; - "gnapprox", `One 0x02A8A; - "gnE", `One 0x02269; - "gne", `One 0x02A88; - "gneq", `One 0x02A88; - "gneqq", `One 0x02269; - "gnsim", `One 0x022E7; - "Gopf", `One 0x1D53E; - "gopf", `One 0x1D558; - "grave", `One 0x00060; - "GreaterEqual", `One 0x02265; - "GreaterEqualLess", `One 0x022DB; - "GreaterFullEqual", `One 0x02267; - "GreaterGreater", `One 0x02AA2; - "GreaterLess", `One 0x02277; - "GreaterSlantEqual", `One 0x02A7E; - "GreaterTilde", `One 0x02273; - "Gscr", `One 0x1D4A2; - "gscr", `One 0x0210A; - "gsim", `One 0x02273; - "gsime", `One 0x02A8E; - "gsiml", `One 0x02A90; - "GT", `One 0x0003E; - "G", `One 0x0003E; - "Gt", `One 0x0226B; - "gt", `One 0x0003E; - "g", `One 0x0003E; - "gtcc", `One 0x02AA7; - "gtcir", `One 0x02A7A; - "gtdot", `One 0x022D7; - "gtlPar", `One 0x02995; - "gtquest", `One 0x02A7C; - "gtrapprox", `One 0x02A86; - "gtrarr", `One 0x02978; - "gtrdot", `One 0x022D7; - "gtreqless", `One 0x022DB; - "gtreqqless", `One 0x02A8C; - "gtrless", `One 0x02277; - "gtrsim", `One 0x02273; - "gvertneqq", `Two (0x02269, 0x0FE00); - "gvnE", `Two (0x02269, 0x0FE00); - "Hacek", `One 0x002C7; - "hairsp", `One 0x0200A; - "half", `One 0x000BD; - "hamilt", `One 0x0210B; - "HARDcy", `One 0x0042A; - "hardcy", `One 0x0044A; - "hArr", `One 0x021D4; - "harr", `One 0x02194; - "harrcir", `One 0x02948; - "harrw", `One 0x021AD; - "Hat", `One 0x0005E; - "hbar", `One 0x0210F; - "Hcirc", `One 0x00124; - "hcirc", `One 0x00125; - "hearts", `One 0x02665; - "heartsuit", `One 0x02665; - "hellip", `One 0x02026; - "hercon", `One 0x022B9; - "Hfr", `One 0x0210C; - "hfr", `One 0x1D525; - "HilbertSpace", `One 0x0210B; - "hksearow", `One 0x02925; - "hkswarow", `One 0x02926; - "hoarr", `One 0x021FF; - "homtht", `One 0x0223B; - "hookleftarrow", `One 0x021A9; - "hookrightarrow", `One 0x021AA; - "Hopf", `One 0x0210D; - "hopf", `One 0x1D559; - "horbar", `One 0x02015; - "HorizontalLine", `One 0x02500; - "Hscr", `One 0x0210B; - "hscr", `One 0x1D4BD; - "hslash", `One 0x0210F; - "Hstrok", `One 0x00126; - "hstrok", `One 0x00127; - "HumpDownHump", `One 0x0224E; - "HumpEqual", `One 0x0224F; - "hybull", `One 0x02043; - "hyphen", `One 0x02010; - "Iacute", `One 0x000CD; - "Iacut", `One 0x000CD; - "iacute", `One 0x000ED; - "iacut", `One 0x000ED; - "ic", `One 0x02063; - "Icirc", `One 0x000CE; - "Icir", `One 0x000CE; - "icirc", `One 0x000EE; - "icir", `One 0x000EE; - "Icy", `One 0x00418; - "icy", `One 0x00438; - "Idot", `One 0x00130; - "IEcy", `One 0x00415; - "iecy", `One 0x00435; - "iexcl", `One 0x000A1; - "iexc", `One 0x000A1; - "iff", `One 0x021D4; - "Ifr", `One 0x02111; - "ifr", `One 0x1D526; - "Igrave", `One 0x000CC; - "Igrav", `One 0x000CC; - "igrave", `One 0x000EC; - "igrav", `One 0x000EC; - "ii", `One 0x02148; - "iiiint", `One 0x02A0C; - "iiint", `One 0x0222D; - "iinfin", `One 0x029DC; - "iiota", `One 0x02129; - "IJlig", `One 0x00132; - "ijlig", `One 0x00133; - "Im", `One 0x02111; - "Imacr", `One 0x0012A; - "imacr", `One 0x0012B; - "image", `One 0x02111; - "ImaginaryI", `One 0x02148; - "imagline", `One 0x02110; - "imagpart", `One 0x02111; - "imath", `One 0x00131; - "imof", `One 0x022B7; - "imped", `One 0x001B5; - "Implies", `One 0x021D2; - "in", `One 0x02208; - "incare", `One 0x02105; - "infin", `One 0x0221E; - "infintie", `One 0x029DD; - "inodot", `One 0x00131; - "Int", `One 0x0222C; - "int", `One 0x0222B; - "intcal", `One 0x022BA; - "integers", `One 0x02124; - "Integral", `One 0x0222B; - "intercal", `One 0x022BA; - "Intersection", `One 0x022C2; - "intlarhk", `One 0x02A17; - "intprod", `One 0x02A3C; - "InvisibleComma", `One 0x02063; - "InvisibleTimes", `One 0x02062; - "IOcy", `One 0x00401; - "iocy", `One 0x00451; - "Iogon", `One 0x0012E; - "iogon", `One 0x0012F; - "Iopf", `One 0x1D540; - "iopf", `One 0x1D55A; - "Iota", `One 0x00399; - "iota", `One 0x003B9; - "iprod", `One 0x02A3C; - "iquest", `One 0x000BF; - "iques", `One 0x000BF; - "Iscr", `One 0x02110; - "iscr", `One 0x1D4BE; - "isin", `One 0x02208; - "isindot", `One 0x022F5; - "isinE", `One 0x022F9; - "isins", `One 0x022F4; - "isinsv", `One 0x022F3; - "isinv", `One 0x02208; - "it", `One 0x02062; - "Itilde", `One 0x00128; - "itilde", `One 0x00129; - "Iukcy", `One 0x00406; - "iukcy", `One 0x00456; - "Iuml", `One 0x000CF; - "Ium", `One 0x000CF; - "iuml", `One 0x000EF; - "ium", `One 0x000EF; - "Jcirc", `One 0x00134; - "jcirc", `One 0x00135; - "Jcy", `One 0x00419; - "jcy", `One 0x00439; - "Jfr", `One 0x1D50D; - "jfr", `One 0x1D527; - "jmath", `One 0x00237; - "Jopf", `One 0x1D541; - "jopf", `One 0x1D55B; - "Jscr", `One 0x1D4A5; - "jscr", `One 0x1D4BF; - "Jsercy", `One 0x00408; - "jsercy", `One 0x00458; - "Jukcy", `One 0x00404; - "jukcy", `One 0x00454; - "Kappa", `One 0x0039A; - "kappa", `One 0x003BA; - "kappav", `One 0x003F0; - "Kcedil", `One 0x00136; - "kcedil", `One 0x00137; - "Kcy", `One 0x0041A; - "kcy", `One 0x0043A; - "Kfr", `One 0x1D50E; - "kfr", `One 0x1D528; - "kgreen", `One 0x00138; - "KHcy", `One 0x00425; - "khcy", `One 0x00445; - "KJcy", `One 0x0040C; - "kjcy", `One 0x0045C; - "Kopf", `One 0x1D542; - "kopf", `One 0x1D55C; - "Kscr", `One 0x1D4A6; - "kscr", `One 0x1D4C0; - "lAarr", `One 0x021DA; - "Lacute", `One 0x00139; - "lacute", `One 0x0013A; - "laemptyv", `One 0x029B4; - "lagran", `One 0x02112; - "Lambda", `One 0x0039B; - "lambda", `One 0x003BB; - "Lang", `One 0x027EA; - "lang", `One 0x027E8; - "langd", `One 0x02991; - "langle", `One 0x027E8; - "lap", `One 0x02A85; - "Laplacetrf", `One 0x02112; - "laquo", `One 0x000AB; - "laqu", `One 0x000AB; - "Larr", `One 0x0219E; - "lArr", `One 0x021D0; - "larr", `One 0x02190; - "larrb", `One 0x021E4; - "larrbfs", `One 0x0291F; - "larrfs", `One 0x0291D; - "larrhk", `One 0x021A9; - "larrlp", `One 0x021AB; - "larrpl", `One 0x02939; - "larrsim", `One 0x02973; - "larrtl", `One 0x021A2; - "lat", `One 0x02AAB; - "lAtail", `One 0x0291B; - "latail", `One 0x02919; - "late", `One 0x02AAD; - "lates", `Two (0x02AAD, 0x0FE00); - "lBarr", `One 0x0290E; - "lbarr", `One 0x0290C; - "lbbrk", `One 0x02772; - "lbrace", `One 0x0007B; - "lbrack", `One 0x0005B; - "lbrke", `One 0x0298B; - "lbrksld", `One 0x0298F; - "lbrkslu", `One 0x0298D; - "Lcaron", `One 0x0013D; - "lcaron", `One 0x0013E; - "Lcedil", `One 0x0013B; - "lcedil", `One 0x0013C; - "lceil", `One 0x02308; - "lcub", `One 0x0007B; - "Lcy", `One 0x0041B; - "lcy", `One 0x0043B; - "ldca", `One 0x02936; - "ldquo", `One 0x0201C; - "ldquor", `One 0x0201E; - "ldrdhar", `One 0x02967; - "ldrushar", `One 0x0294B; - "ldsh", `One 0x021B2; - "lE", `One 0x02266; - "le", `One 0x02264; - "LeftAngleBracket", `One 0x027E8; - "LeftArrow", `One 0x02190; - "Leftarrow", `One 0x021D0; - "leftarrow", `One 0x02190; - "LeftArrowBar", `One 0x021E4; - "LeftArrowRightArrow", `One 0x021C6; - "leftarrowtail", `One 0x021A2; - "LeftCeiling", `One 0x02308; - "LeftDoubleBracket", `One 0x027E6; - "LeftDownTeeVector", `One 0x02961; - "LeftDownVector", `One 0x021C3; - "LeftDownVectorBar", `One 0x02959; - "LeftFloor", `One 0x0230A; - "leftharpoondown", `One 0x021BD; - "leftharpoonup", `One 0x021BC; - "leftleftarrows", `One 0x021C7; - "LeftRightArrow", `One 0x02194; - "Leftrightarrow", `One 0x021D4; - "leftrightarrow", `One 0x02194; - "leftrightarrows", `One 0x021C6; - "leftrightharpoons", `One 0x021CB; - "leftrightsquigarrow", `One 0x021AD; - "LeftRightVector", `One 0x0294E; - "LeftTee", `One 0x022A3; - "LeftTeeArrow", `One 0x021A4; - "LeftTeeVector", `One 0x0295A; - "leftthreetimes", `One 0x022CB; - "LeftTriangle", `One 0x022B2; - "LeftTriangleBar", `One 0x029CF; - "LeftTriangleEqual", `One 0x022B4; - "LeftUpDownVector", `One 0x02951; - "LeftUpTeeVector", `One 0x02960; - "LeftUpVector", `One 0x021BF; - "LeftUpVectorBar", `One 0x02958; - "LeftVector", `One 0x021BC; - "LeftVectorBar", `One 0x02952; - "lEg", `One 0x02A8B; - "leg", `One 0x022DA; - "leq", `One 0x02264; - "leqq", `One 0x02266; - "leqslant", `One 0x02A7D; - "les", `One 0x02A7D; - "lescc", `One 0x02AA8; - "lesdot", `One 0x02A7F; - "lesdoto", `One 0x02A81; - "lesdotor", `One 0x02A83; - "lesg", `Two (0x022DA, 0x0FE00); - "lesges", `One 0x02A93; - "lessapprox", `One 0x02A85; - "lessdot", `One 0x022D6; - "lesseqgtr", `One 0x022DA; - "lesseqqgtr", `One 0x02A8B; - "LessEqualGreater", `One 0x022DA; - "LessFullEqual", `One 0x02266; - "LessGreater", `One 0x02276; - "lessgtr", `One 0x02276; - "LessLess", `One 0x02AA1; - "lesssim", `One 0x02272; - "LessSlantEqual", `One 0x02A7D; - "LessTilde", `One 0x02272; - "lfisht", `One 0x0297C; - "lfloor", `One 0x0230A; - "Lfr", `One 0x1D50F; - "lfr", `One 0x1D529; - "lg", `One 0x02276; - "lgE", `One 0x02A91; - "lHar", `One 0x02962; - "lhard", `One 0x021BD; - "lharu", `One 0x021BC; - "lharul", `One 0x0296A; - "lhblk", `One 0x02584; - "LJcy", `One 0x00409; - "ljcy", `One 0x00459; - "Ll", `One 0x022D8; - "ll", `One 0x0226A; - "llarr", `One 0x021C7; - "llcorner", `One 0x0231E; - "Lleftarrow", `One 0x021DA; - "llhard", `One 0x0296B; - "lltri", `One 0x025FA; - "Lmidot", `One 0x0013F; - "lmidot", `One 0x00140; - "lmoust", `One 0x023B0; - "lmoustache", `One 0x023B0; - "lnap", `One 0x02A89; - "lnapprox", `One 0x02A89; - "lnE", `One 0x02268; - "lne", `One 0x02A87; - "lneq", `One 0x02A87; - "lneqq", `One 0x02268; - "lnsim", `One 0x022E6; - "loang", `One 0x027EC; - "loarr", `One 0x021FD; - "lobrk", `One 0x027E6; - "LongLeftArrow", `One 0x027F5; - "Longleftarrow", `One 0x027F8; - "longleftarrow", `One 0x027F5; - "LongLeftRightArrow", `One 0x027F7; - "Longleftrightarrow", `One 0x027FA; - "longleftrightarrow", `One 0x027F7; - "longmapsto", `One 0x027FC; - "LongRightArrow", `One 0x027F6; - "Longrightarrow", `One 0x027F9; - "longrightarrow", `One 0x027F6; - "looparrowleft", `One 0x021AB; - "looparrowright", `One 0x021AC; - "lopar", `One 0x02985; - "Lopf", `One 0x1D543; - "lopf", `One 0x1D55D; - "loplus", `One 0x02A2D; - "lotimes", `One 0x02A34; - "lowast", `One 0x02217; - "lowbar", `One 0x0005F; - "LowerLeftArrow", `One 0x02199; - "LowerRightArrow", `One 0x02198; - "loz", `One 0x025CA; - "lozenge", `One 0x025CA; - "lozf", `One 0x029EB; - "lpar", `One 0x00028; - "lparlt", `One 0x02993; - "lrarr", `One 0x021C6; - "lrcorner", `One 0x0231F; - "lrhar", `One 0x021CB; - "lrhard", `One 0x0296D; - "lrm", `One 0x0200E; - "lrtri", `One 0x022BF; - "lsaquo", `One 0x02039; - "Lscr", `One 0x02112; - "lscr", `One 0x1D4C1; - "Lsh", `One 0x021B0; - "lsh", `One 0x021B0; - "lsim", `One 0x02272; - "lsime", `One 0x02A8D; - "lsimg", `One 0x02A8F; - "lsqb", `One 0x0005B; - "lsquo", `One 0x02018; - "lsquor", `One 0x0201A; - "Lstrok", `One 0x00141; - "lstrok", `One 0x00142; - "LT", `One 0x0003C; - "L", `One 0x0003C; - "Lt", `One 0x0226A; - "lt", `One 0x0003C; - "l", `One 0x0003C; - "ltcc", `One 0x02AA6; - "ltcir", `One 0x02A79; - "ltdot", `One 0x022D6; - "lthree", `One 0x022CB; - "ltimes", `One 0x022C9; - "ltlarr", `One 0x02976; - "ltquest", `One 0x02A7B; - "ltri", `One 0x025C3; - "ltrie", `One 0x022B4; - "ltrif", `One 0x025C2; - "ltrPar", `One 0x02996; - "lurdshar", `One 0x0294A; - "luruhar", `One 0x02966; - "lvertneqq", `Two (0x02268, 0x0FE00); - "lvnE", `Two (0x02268, 0x0FE00); - "macr", `One 0x000AF; - "mac", `One 0x000AF; - "male", `One 0x02642; - "malt", `One 0x02720; - "maltese", `One 0x02720; - "Map", `One 0x02905; - "map", `One 0x021A6; - "mapsto", `One 0x021A6; - "mapstodown", `One 0x021A7; - "mapstoleft", `One 0x021A4; - "mapstoup", `One 0x021A5; - "marker", `One 0x025AE; - "mcomma", `One 0x02A29; - "Mcy", `One 0x0041C; - "mcy", `One 0x0043C; - "mdash", `One 0x02014; - "mDDot", `One 0x0223A; - "measuredangle", `One 0x02221; - "MediumSpace", `One 0x0205F; - "Mellintrf", `One 0x02133; - "Mfr", `One 0x1D510; - "mfr", `One 0x1D52A; - "mho", `One 0x02127; - "micro", `One 0x000B5; - "micr", `One 0x000B5; - "mid", `One 0x02223; - "midast", `One 0x0002A; - "midcir", `One 0x02AF0; - "middot", `One 0x000B7; - "middo", `One 0x000B7; - "minus", `One 0x02212; - "minusb", `One 0x0229F; - "minusd", `One 0x02238; - "minusdu", `One 0x02A2A; - "MinusPlus", `One 0x02213; - "mlcp", `One 0x02ADB; - "mldr", `One 0x02026; - "mnplus", `One 0x02213; - "models", `One 0x022A7; - "Mopf", `One 0x1D544; - "mopf", `One 0x1D55E; - "mp", `One 0x02213; - "Mscr", `One 0x02133; - "mscr", `One 0x1D4C2; - "mstpos", `One 0x0223E; - "Mu", `One 0x0039C; - "mu", `One 0x003BC; - "multimap", `One 0x022B8; - "mumap", `One 0x022B8; - "nabla", `One 0x02207; - "Nacute", `One 0x00143; - "nacute", `One 0x00144; - "nang", `Two (0x02220, 0x020D2); - "nap", `One 0x02249; - "napE", `Two (0x02A70, 0x00338); - "napid", `Two (0x0224B, 0x00338); - "napos", `One 0x00149; - "napprox", `One 0x02249; - "natur", `One 0x0266E; - "natural", `One 0x0266E; - "naturals", `One 0x02115; - "nbsp", `One 0x000A0; - "nbs", `One 0x000A0; - "nbump", `Two (0x0224E, 0x00338); - "nbumpe", `Two (0x0224F, 0x00338); - "ncap", `One 0x02A43; - "Ncaron", `One 0x00147; - "ncaron", `One 0x00148; - "Ncedil", `One 0x00145; - "ncedil", `One 0x00146; - "ncong", `One 0x02247; - "ncongdot", `Two (0x02A6D, 0x00338); - "ncup", `One 0x02A42; - "Ncy", `One 0x0041D; - "ncy", `One 0x0043D; - "ndash", `One 0x02013; - "ne", `One 0x02260; - "nearhk", `One 0x02924; - "neArr", `One 0x021D7; - "nearr", `One 0x02197; - "nearrow", `One 0x02197; - "nedot", `Two (0x02250, 0x00338); - "NegativeMediumSpace", `One 0x0200B; - "NegativeThickSpace", `One 0x0200B; - "NegativeThinSpace", `One 0x0200B; - "NegativeVeryThinSpace", `One 0x0200B; - "nequiv", `One 0x02262; - "nesear", `One 0x02928; - "nesim", `Two (0x02242, 0x00338); - "NestedGreaterGreater", `One 0x0226B; - "NestedLessLess", `One 0x0226A; - "NewLine", `One 0x0000A; - "nexist", `One 0x02204; - "nexists", `One 0x02204; - "Nfr", `One 0x1D511; - "nfr", `One 0x1D52B; - "ngE", `Two (0x02267, 0x00338); - "nge", `One 0x02271; - "ngeq", `One 0x02271; - "ngeqq", `Two (0x02267, 0x00338); - "ngeqslant", `Two (0x02A7E, 0x00338); - "nges", `Two (0x02A7E, 0x00338); - "nGg", `Two (0x022D9, 0x00338); - "ngsim", `One 0x02275; - "nGt", `Two (0x0226B, 0x020D2); - "ngt", `One 0x0226F; - "ngtr", `One 0x0226F; - "nGtv", `Two (0x0226B, 0x00338); - "nhArr", `One 0x021CE; - "nharr", `One 0x021AE; - "nhpar", `One 0x02AF2; - "ni", `One 0x0220B; - "nis", `One 0x022FC; - "nisd", `One 0x022FA; - "niv", `One 0x0220B; - "NJcy", `One 0x0040A; - "njcy", `One 0x0045A; - "nlArr", `One 0x021CD; - "nlarr", `One 0x0219A; - "nldr", `One 0x02025; - "nlE", `Two (0x02266, 0x00338); - "nle", `One 0x02270; - "nLeftarrow", `One 0x021CD; - "nleftarrow", `One 0x0219A; - "nLeftrightarrow", `One 0x021CE; - "nleftrightarrow", `One 0x021AE; - "nleq", `One 0x02270; - "nleqq", `Two (0x02266, 0x00338); - "nleqslant", `Two (0x02A7D, 0x00338); - "nles", `Two (0x02A7D, 0x00338); - "nless", `One 0x0226E; - "nLl", `Two (0x022D8, 0x00338); - "nlsim", `One 0x02274; - "nLt", `Two (0x0226A, 0x020D2); - "nlt", `One 0x0226E; - "nltri", `One 0x022EA; - "nltrie", `One 0x022EC; - "nLtv", `Two (0x0226A, 0x00338); - "nmid", `One 0x02224; - "NoBreak", `One 0x02060; - "NonBreakingSpace", `One 0x000A0; - "Nopf", `One 0x02115; - "nopf", `One 0x1D55F; - "Not", `One 0x02AEC; - "not", `One 0x000AC; - "no", `One 0x000AC; - "NotCongruent", `One 0x02262; - "NotCupCap", `One 0x0226D; - "NotDoubleVerticalBar", `One 0x02226; - "NotElement", `One 0x02209; - "NotEqual", `One 0x02260; - "NotEqualTilde", `Two (0x02242, 0x00338); - "NotExists", `One 0x02204; - "NotGreater", `One 0x0226F; - "NotGreaterEqual", `One 0x02271; - "NotGreaterFullEqual", `Two (0x02267, 0x00338); - "NotGreaterGreater", `Two (0x0226B, 0x00338); - "NotGreaterLess", `One 0x02279; - "NotGreaterSlantEqual", `Two (0x02A7E, 0x00338); - "NotGreaterTilde", `One 0x02275; - "NotHumpDownHump", `Two (0x0224E, 0x00338); - "NotHumpEqual", `Two (0x0224F, 0x00338); - "notin", `One 0x02209; - "notindot", `Two (0x022F5, 0x00338); - "notinE", `Two (0x022F9, 0x00338); - "notinva", `One 0x02209; - "notinvb", `One 0x022F7; - "notinvc", `One 0x022F6; - "NotLeftTriangle", `One 0x022EA; - "NotLeftTriangleBar", `Two (0x029CF, 0x00338); - "NotLeftTriangleEqual", `One 0x022EC; - "NotLess", `One 0x0226E; - "NotLessEqual", `One 0x02270; - "NotLessGreater", `One 0x02278; - "NotLessLess", `Two (0x0226A, 0x00338); - "NotLessSlantEqual", `Two (0x02A7D, 0x00338); - "NotLessTilde", `One 0x02274; - "NotNestedGreaterGreater", `Two (0x02AA2, 0x00338); - "NotNestedLessLess", `Two (0x02AA1, 0x00338); - "notni", `One 0x0220C; - "notniva", `One 0x0220C; - "notnivb", `One 0x022FE; - "notnivc", `One 0x022FD; - "NotPrecedes", `One 0x02280; - "NotPrecedesEqual", `Two (0x02AAF, 0x00338); - "NotPrecedesSlantEqual", `One 0x022E0; - "NotReverseElement", `One 0x0220C; - "NotRightTriangle", `One 0x022EB; - "NotRightTriangleBar", `Two (0x029D0, 0x00338); - "NotRightTriangleEqual", `One 0x022ED; - "NotSquareSubset", `Two (0x0228F, 0x00338); - "NotSquareSubsetEqual", `One 0x022E2; - "NotSquareSuperset", `Two (0x02290, 0x00338); - "NotSquareSupersetEqual", `One 0x022E3; - "NotSubset", `Two (0x02282, 0x020D2); - "NotSubsetEqual", `One 0x02288; - "NotSucceeds", `One 0x02281; - "NotSucceedsEqual", `Two (0x02AB0, 0x00338); - "NotSucceedsSlantEqual", `One 0x022E1; - "NotSucceedsTilde", `Two (0x0227F, 0x00338); - "NotSuperset", `Two (0x02283, 0x020D2); - "NotSupersetEqual", `One 0x02289; - "NotTilde", `One 0x02241; - "NotTildeEqual", `One 0x02244; - "NotTildeFullEqual", `One 0x02247; - "NotTildeTilde", `One 0x02249; - "NotVerticalBar", `One 0x02224; - "npar", `One 0x02226; - "nparallel", `One 0x02226; - "nparsl", `Two (0x02AFD, 0x020E5); - "npart", `Two (0x02202, 0x00338); - "npolint", `One 0x02A14; - "npr", `One 0x02280; - "nprcue", `One 0x022E0; - "npre", `Two (0x02AAF, 0x00338); - "nprec", `One 0x02280; - "npreceq", `Two (0x02AAF, 0x00338); - "nrArr", `One 0x021CF; - "nrarr", `One 0x0219B; - "nrarrc", `Two (0x02933, 0x00338); - "nrarrw", `Two (0x0219D, 0x00338); - "nRightarrow", `One 0x021CF; - "nrightarrow", `One 0x0219B; - "nrtri", `One 0x022EB; - "nrtrie", `One 0x022ED; - "nsc", `One 0x02281; - "nsccue", `One 0x022E1; - "nsce", `Two (0x02AB0, 0x00338); - "Nscr", `One 0x1D4A9; - "nscr", `One 0x1D4C3; - "nshortmid", `One 0x02224; - "nshortparallel", `One 0x02226; - "nsim", `One 0x02241; - "nsime", `One 0x02244; - "nsimeq", `One 0x02244; - "nsmid", `One 0x02224; - "nspar", `One 0x02226; - "nsqsube", `One 0x022E2; - "nsqsupe", `One 0x022E3; - "nsub", `One 0x02284; - "nsubE", `Two (0x02AC5, 0x00338); - "nsube", `One 0x02288; - "nsubset", `Two (0x02282, 0x020D2); - "nsubseteq", `One 0x02288; - "nsubseteqq", `Two (0x02AC5, 0x00338); - "nsucc", `One 0x02281; - "nsucceq", `Two (0x02AB0, 0x00338); - "nsup", `One 0x02285; - "nsupE", `Two (0x02AC6, 0x00338); - "nsupe", `One 0x02289; - "nsupset", `Two (0x02283, 0x020D2); - "nsupseteq", `One 0x02289; - "nsupseteqq", `Two (0x02AC6, 0x00338); - "ntgl", `One 0x02279; - "Ntilde", `One 0x000D1; - "Ntild", `One 0x000D1; - "ntilde", `One 0x000F1; - "ntild", `One 0x000F1; - "ntlg", `One 0x02278; - "ntriangleleft", `One 0x022EA; - "ntrianglelefteq", `One 0x022EC; - "ntriangleright", `One 0x022EB; - "ntrianglerighteq", `One 0x022ED; - "Nu", `One 0x0039D; - "nu", `One 0x003BD; - "num", `One 0x00023; - "numero", `One 0x02116; - "numsp", `One 0x02007; - "nvap", `Two (0x0224D, 0x020D2); - "nVDash", `One 0x022AF; - "nVdash", `One 0x022AE; - "nvDash", `One 0x022AD; - "nvdash", `One 0x022AC; - "nvge", `Two (0x02265, 0x020D2); - "nvgt", `Two (0x0003E, 0x020D2); - "nvHarr", `One 0x02904; - "nvinfin", `One 0x029DE; - "nvlArr", `One 0x02902; - "nvle", `Two (0x02264, 0x020D2); - "nvlt", `Two (0x0003C, 0x020D2); - "nvltrie", `Two (0x022B4, 0x020D2); - "nvrArr", `One 0x02903; - "nvrtrie", `Two (0x022B5, 0x020D2); - "nvsim", `Two (0x0223C, 0x020D2); - "nwarhk", `One 0x02923; - "nwArr", `One 0x021D6; - "nwarr", `One 0x02196; - "nwarrow", `One 0x02196; - "nwnear", `One 0x02927; - "Oacute", `One 0x000D3; - "Oacut", `One 0x000D3; - "oacute", `One 0x000F3; - "oacut", `One 0x000F3; - "oast", `One 0x0229B; - "ocir", `One 0x0229A; - "Ocirc", `One 0x000D4; - "Ocir", `One 0x000D4; - "ocirc", `One 0x000F4; - "ocir", `One 0x000F4; - "Ocy", `One 0x0041E; - "ocy", `One 0x0043E; - "odash", `One 0x0229D; - "Odblac", `One 0x00150; - "odblac", `One 0x00151; - "odiv", `One 0x02A38; - "odot", `One 0x02299; - "odsold", `One 0x029BC; - "OElig", `One 0x00152; - "oelig", `One 0x00153; - "ofcir", `One 0x029BF; - "Ofr", `One 0x1D512; - "ofr", `One 0x1D52C; - "ogon", `One 0x002DB; - "Ograve", `One 0x000D2; - "Ograv", `One 0x000D2; - "ograve", `One 0x000F2; - "ograv", `One 0x000F2; - "ogt", `One 0x029C1; - "ohbar", `One 0x029B5; - "ohm", `One 0x003A9; - "oint", `One 0x0222E; - "olarr", `One 0x021BA; - "olcir", `One 0x029BE; - "olcross", `One 0x029BB; - "oline", `One 0x0203E; - "olt", `One 0x029C0; - "Omacr", `One 0x0014C; - "omacr", `One 0x0014D; - "Omega", `One 0x003A9; - "omega", `One 0x003C9; - "Omicron", `One 0x0039F; - "omicron", `One 0x003BF; - "omid", `One 0x029B6; - "ominus", `One 0x02296; - "Oopf", `One 0x1D546; - "oopf", `One 0x1D560; - "opar", `One 0x029B7; - "OpenCurlyDoubleQuote", `One 0x0201C; - "OpenCurlyQuote", `One 0x02018; - "operp", `One 0x029B9; - "oplus", `One 0x02295; - "Or", `One 0x02A54; - "or", `One 0x02228; - "orarr", `One 0x021BB; - "ord", `One 0x02A5D; - "order", `One 0x02134; - "orderof", `One 0x02134; - "ordf", `One 0x000AA; - "ord", `One 0x000AA; - "ordm", `One 0x000BA; - "ord", `One 0x000BA; - "origof", `One 0x022B6; - "oror", `One 0x02A56; - "orslope", `One 0x02A57; - "orv", `One 0x02A5B; - "oS", `One 0x024C8; - "Oscr", `One 0x1D4AA; - "oscr", `One 0x02134; - "Oslash", `One 0x000D8; - "Oslas", `One 0x000D8; - "oslash", `One 0x000F8; - "oslas", `One 0x000F8; - "osol", `One 0x02298; - "Otilde", `One 0x000D5; - "Otild", `One 0x000D5; - "otilde", `One 0x000F5; - "otild", `One 0x000F5; - "Otimes", `One 0x02A37; - "otimes", `One 0x02297; - "otimesas", `One 0x02A36; - "Ouml", `One 0x000D6; - "Oum", `One 0x000D6; - "ouml", `One 0x000F6; - "oum", `One 0x000F6; - "ovbar", `One 0x0233D; - "OverBar", `One 0x0203E; - "OverBrace", `One 0x023DE; - "OverBracket", `One 0x023B4; - "OverParenthesis", `One 0x023DC; - "par", `One 0x02225; - "para", `One 0x000B6; - "par", `One 0x000B6; - "parallel", `One 0x02225; - "parsim", `One 0x02AF3; - "parsl", `One 0x02AFD; - "part", `One 0x02202; - "PartialD", `One 0x02202; - "Pcy", `One 0x0041F; - "pcy", `One 0x0043F; - "percnt", `One 0x00025; - "period", `One 0x0002E; - "permil", `One 0x02030; - "perp", `One 0x022A5; - "pertenk", `One 0x02031; - "Pfr", `One 0x1D513; - "pfr", `One 0x1D52D; - "Phi", `One 0x003A6; - "phi", `One 0x003C6; - "phiv", `One 0x003D5; - "phmmat", `One 0x02133; - "phone", `One 0x0260E; - "Pi", `One 0x003A0; - "pi", `One 0x003C0; - "pitchfork", `One 0x022D4; - "piv", `One 0x003D6; - "planck", `One 0x0210F; - "planckh", `One 0x0210E; - "plankv", `One 0x0210F; - "plus", `One 0x0002B; - "plusacir", `One 0x02A23; - "plusb", `One 0x0229E; - "pluscir", `One 0x02A22; - "plusdo", `One 0x02214; - "plusdu", `One 0x02A25; - "pluse", `One 0x02A72; - "PlusMinus", `One 0x000B1; - "plusmn", `One 0x000B1; - "plusm", `One 0x000B1; - "plussim", `One 0x02A26; - "plustwo", `One 0x02A27; - "pm", `One 0x000B1; - "Poincareplane", `One 0x0210C; - "pointint", `One 0x02A15; - "Popf", `One 0x02119; - "popf", `One 0x1D561; - "pound", `One 0x000A3; - "poun", `One 0x000A3; - "Pr", `One 0x02ABB; - "pr", `One 0x0227A; - "prap", `One 0x02AB7; - "prcue", `One 0x0227C; - "prE", `One 0x02AB3; - "pre", `One 0x02AAF; - "prec", `One 0x0227A; - "precapprox", `One 0x02AB7; - "preccurlyeq", `One 0x0227C; - "Precedes", `One 0x0227A; - "PrecedesEqual", `One 0x02AAF; - "PrecedesSlantEqual", `One 0x0227C; - "PrecedesTilde", `One 0x0227E; - "preceq", `One 0x02AAF; - "precnapprox", `One 0x02AB9; - "precneqq", `One 0x02AB5; - "precnsim", `One 0x022E8; - "precsim", `One 0x0227E; - "Prime", `One 0x02033; - "prime", `One 0x02032; - "primes", `One 0x02119; - "prnap", `One 0x02AB9; - "prnE", `One 0x02AB5; - "prnsim", `One 0x022E8; - "prod", `One 0x0220F; - "Product", `One 0x0220F; - "profalar", `One 0x0232E; - "profline", `One 0x02312; - "profsurf", `One 0x02313; - "prop", `One 0x0221D; - "Proportion", `One 0x02237; - "Proportional", `One 0x0221D; - "propto", `One 0x0221D; - "prsim", `One 0x0227E; - "prurel", `One 0x022B0; - "Pscr", `One 0x1D4AB; - "pscr", `One 0x1D4C5; - "Psi", `One 0x003A8; - "psi", `One 0x003C8; - "puncsp", `One 0x02008; - "Qfr", `One 0x1D514; - "qfr", `One 0x1D52E; - "qint", `One 0x02A0C; - "Qopf", `One 0x0211A; - "qopf", `One 0x1D562; - "qprime", `One 0x02057; - "Qscr", `One 0x1D4AC; - "qscr", `One 0x1D4C6; - "quaternions", `One 0x0210D; - "quatint", `One 0x02A16; - "quest", `One 0x0003F; - "questeq", `One 0x0225F; - "QUOT", `One 0x00022; - "QUO", `One 0x00022; - "quot", `One 0x00022; - "quo", `One 0x00022; - "rAarr", `One 0x021DB; - "race", `Two (0x0223D, 0x00331); - "Racute", `One 0x00154; - "racute", `One 0x00155; - "radic", `One 0x0221A; - "raemptyv", `One 0x029B3; - "Rang", `One 0x027EB; - "rang", `One 0x027E9; - "rangd", `One 0x02992; - "range", `One 0x029A5; - "rangle", `One 0x027E9; - "raquo", `One 0x000BB; - "raqu", `One 0x000BB; - "Rarr", `One 0x021A0; - "rArr", `One 0x021D2; - "rarr", `One 0x02192; - "rarrap", `One 0x02975; - "rarrb", `One 0x021E5; - "rarrbfs", `One 0x02920; - "rarrc", `One 0x02933; - "rarrfs", `One 0x0291E; - "rarrhk", `One 0x021AA; - "rarrlp", `One 0x021AC; - "rarrpl", `One 0x02945; - "rarrsim", `One 0x02974; - "Rarrtl", `One 0x02916; - "rarrtl", `One 0x021A3; - "rarrw", `One 0x0219D; - "rAtail", `One 0x0291C; - "ratail", `One 0x0291A; - "ratio", `One 0x02236; - "rationals", `One 0x0211A; - "RBarr", `One 0x02910; - "rBarr", `One 0x0290F; - "rbarr", `One 0x0290D; - "rbbrk", `One 0x02773; - "rbrace", `One 0x0007D; - "rbrack", `One 0x0005D; - "rbrke", `One 0x0298C; - "rbrksld", `One 0x0298E; - "rbrkslu", `One 0x02990; - "Rcaron", `One 0x00158; - "rcaron", `One 0x00159; - "Rcedil", `One 0x00156; - "rcedil", `One 0x00157; - "rceil", `One 0x02309; - "rcub", `One 0x0007D; - "Rcy", `One 0x00420; - "rcy", `One 0x00440; - "rdca", `One 0x02937; - "rdldhar", `One 0x02969; - "rdquo", `One 0x0201D; - "rdquor", `One 0x0201D; - "rdsh", `One 0x021B3; - "Re", `One 0x0211C; - "real", `One 0x0211C; - "realine", `One 0x0211B; - "realpart", `One 0x0211C; - "reals", `One 0x0211D; - "rect", `One 0x025AD; - "REG", `One 0x000AE; - "RE", `One 0x000AE; - "reg", `One 0x000AE; - "re", `One 0x000AE; - "ReverseElement", `One 0x0220B; - "ReverseEquilibrium", `One 0x021CB; - "ReverseUpEquilibrium", `One 0x0296F; - "rfisht", `One 0x0297D; - "rfloor", `One 0x0230B; - "Rfr", `One 0x0211C; - "rfr", `One 0x1D52F; - "rHar", `One 0x02964; - "rhard", `One 0x021C1; - "rharu", `One 0x021C0; - "rharul", `One 0x0296C; - "Rho", `One 0x003A1; - "rho", `One 0x003C1; - "rhov", `One 0x003F1; - "RightAngleBracket", `One 0x027E9; - "RightArrow", `One 0x02192; - "Rightarrow", `One 0x021D2; - "rightarrow", `One 0x02192; - "RightArrowBar", `One 0x021E5; - "RightArrowLeftArrow", `One 0x021C4; - "rightarrowtail", `One 0x021A3; - "RightCeiling", `One 0x02309; - "RightDoubleBracket", `One 0x027E7; - "RightDownTeeVector", `One 0x0295D; - "RightDownVector", `One 0x021C2; - "RightDownVectorBar", `One 0x02955; - "RightFloor", `One 0x0230B; - "rightharpoondown", `One 0x021C1; - "rightharpoonup", `One 0x021C0; - "rightleftarrows", `One 0x021C4; - "rightleftharpoons", `One 0x021CC; - "rightrightarrows", `One 0x021C9; - "rightsquigarrow", `One 0x0219D; - "RightTee", `One 0x022A2; - "RightTeeArrow", `One 0x021A6; - "RightTeeVector", `One 0x0295B; - "rightthreetimes", `One 0x022CC; - "RightTriangle", `One 0x022B3; - "RightTriangleBar", `One 0x029D0; - "RightTriangleEqual", `One 0x022B5; - "RightUpDownVector", `One 0x0294F; - "RightUpTeeVector", `One 0x0295C; - "RightUpVector", `One 0x021BE; - "RightUpVectorBar", `One 0x02954; - "RightVector", `One 0x021C0; - "RightVectorBar", `One 0x02953; - "ring", `One 0x002DA; - "risingdotseq", `One 0x02253; - "rlarr", `One 0x021C4; - "rlhar", `One 0x021CC; - "rlm", `One 0x0200F; - "rmoust", `One 0x023B1; - "rmoustache", `One 0x023B1; - "rnmid", `One 0x02AEE; - "roang", `One 0x027ED; - "roarr", `One 0x021FE; - "robrk", `One 0x027E7; - "ropar", `One 0x02986; - "Ropf", `One 0x0211D; - "ropf", `One 0x1D563; - "roplus", `One 0x02A2E; - "rotimes", `One 0x02A35; - "RoundImplies", `One 0x02970; - "rpar", `One 0x00029; - "rpargt", `One 0x02994; - "rppolint", `One 0x02A12; - "rrarr", `One 0x021C9; - "Rrightarrow", `One 0x021DB; - "rsaquo", `One 0x0203A; - "Rscr", `One 0x0211B; - "rscr", `One 0x1D4C7; - "Rsh", `One 0x021B1; - "rsh", `One 0x021B1; - "rsqb", `One 0x0005D; - "rsquo", `One 0x02019; - "rsquor", `One 0x02019; - "rthree", `One 0x022CC; - "rtimes", `One 0x022CA; - "rtri", `One 0x025B9; - "rtrie", `One 0x022B5; - "rtrif", `One 0x025B8; - "rtriltri", `One 0x029CE; - "RuleDelayed", `One 0x029F4; - "ruluhar", `One 0x02968; - "rx", `One 0x0211E; - "Sacute", `One 0x0015A; - "sacute", `One 0x0015B; - "sbquo", `One 0x0201A; - "Sc", `One 0x02ABC; - "sc", `One 0x0227B; - "scap", `One 0x02AB8; - "Scaron", `One 0x00160; - "scaron", `One 0x00161; - "sccue", `One 0x0227D; - "scE", `One 0x02AB4; - "sce", `One 0x02AB0; - "Scedil", `One 0x0015E; - "scedil", `One 0x0015F; - "Scirc", `One 0x0015C; - "scirc", `One 0x0015D; - "scnap", `One 0x02ABA; - "scnE", `One 0x02AB6; - "scnsim", `One 0x022E9; - "scpolint", `One 0x02A13; - "scsim", `One 0x0227F; - "Scy", `One 0x00421; - "scy", `One 0x00441; - "sdot", `One 0x022C5; - "sdotb", `One 0x022A1; - "sdote", `One 0x02A66; - "searhk", `One 0x02925; - "seArr", `One 0x021D8; - "searr", `One 0x02198; - "searrow", `One 0x02198; - "sect", `One 0x000A7; - "sec", `One 0x000A7; - "semi", `One 0x0003B; - "seswar", `One 0x02929; - "setminus", `One 0x02216; - "setmn", `One 0x02216; - "sext", `One 0x02736; - "Sfr", `One 0x1D516; - "sfr", `One 0x1D530; - "sfrown", `One 0x02322; - "sharp", `One 0x0266F; - "SHCHcy", `One 0x00429; - "shchcy", `One 0x00449; - "SHcy", `One 0x00428; - "shcy", `One 0x00448; - "ShortDownArrow", `One 0x02193; - "ShortLeftArrow", `One 0x02190; - "shortmid", `One 0x02223; - "shortparallel", `One 0x02225; - "ShortRightArrow", `One 0x02192; - "ShortUpArrow", `One 0x02191; - "shy", `One 0x000AD; - "sh", `One 0x000AD; - "Sigma", `One 0x003A3; - "sigma", `One 0x003C3; - "sigmaf", `One 0x003C2; - "sigmav", `One 0x003C2; - "sim", `One 0x0223C; - "simdot", `One 0x02A6A; - "sime", `One 0x02243; - "simeq", `One 0x02243; - "simg", `One 0x02A9E; - "simgE", `One 0x02AA0; - "siml", `One 0x02A9D; - "simlE", `One 0x02A9F; - "simne", `One 0x02246; - "simplus", `One 0x02A24; - "simrarr", `One 0x02972; - "slarr", `One 0x02190; - "SmallCircle", `One 0x02218; - "smallsetminus", `One 0x02216; - "smashp", `One 0x02A33; - "smeparsl", `One 0x029E4; - "smid", `One 0x02223; - "smile", `One 0x02323; - "smt", `One 0x02AAA; - "smte", `One 0x02AAC; - "smtes", `Two (0x02AAC, 0x0FE00); - "SOFTcy", `One 0x0042C; - "softcy", `One 0x0044C; - "sol", `One 0x0002F; - "solb", `One 0x029C4; - "solbar", `One 0x0233F; - "Sopf", `One 0x1D54A; - "sopf", `One 0x1D564; - "spades", `One 0x02660; - "spadesuit", `One 0x02660; - "spar", `One 0x02225; - "sqcap", `One 0x02293; - "sqcaps", `Two (0x02293, 0x0FE00); - "sqcup", `One 0x02294; - "sqcups", `Two (0x02294, 0x0FE00); - "Sqrt", `One 0x0221A; - "sqsub", `One 0x0228F; - "sqsube", `One 0x02291; - "sqsubset", `One 0x0228F; - "sqsubseteq", `One 0x02291; - "sqsup", `One 0x02290; - "sqsupe", `One 0x02292; - "sqsupset", `One 0x02290; - "sqsupseteq", `One 0x02292; - "squ", `One 0x025A1; - "Square", `One 0x025A1; - "square", `One 0x025A1; - "SquareIntersection", `One 0x02293; - "SquareSubset", `One 0x0228F; - "SquareSubsetEqual", `One 0x02291; - "SquareSuperset", `One 0x02290; - "SquareSupersetEqual", `One 0x02292; - "SquareUnion", `One 0x02294; - "squarf", `One 0x025AA; - "squf", `One 0x025AA; - "srarr", `One 0x02192; - "Sscr", `One 0x1D4AE; - "sscr", `One 0x1D4C8; - "ssetmn", `One 0x02216; - "ssmile", `One 0x02323; - "sstarf", `One 0x022C6; - "Star", `One 0x022C6; - "star", `One 0x02606; - "starf", `One 0x02605; - "straightepsilon", `One 0x003F5; - "straightphi", `One 0x003D5; - "strns", `One 0x000AF; - "Sub", `One 0x022D0; - "sub", `One 0x02282; - "subdot", `One 0x02ABD; - "subE", `One 0x02AC5; - "sube", `One 0x02286; - "subedot", `One 0x02AC3; - "submult", `One 0x02AC1; - "subnE", `One 0x02ACB; - "subne", `One 0x0228A; - "subplus", `One 0x02ABF; - "subrarr", `One 0x02979; - "Subset", `One 0x022D0; - "subset", `One 0x02282; - "subseteq", `One 0x02286; - "subseteqq", `One 0x02AC5; - "SubsetEqual", `One 0x02286; - "subsetneq", `One 0x0228A; - "subsetneqq", `One 0x02ACB; - "subsim", `One 0x02AC7; - "subsub", `One 0x02AD5; - "subsup", `One 0x02AD3; - "succ", `One 0x0227B; - "succapprox", `One 0x02AB8; - "succcurlyeq", `One 0x0227D; - "Succeeds", `One 0x0227B; - "SucceedsEqual", `One 0x02AB0; - "SucceedsSlantEqual", `One 0x0227D; - "SucceedsTilde", `One 0x0227F; - "succeq", `One 0x02AB0; - "succnapprox", `One 0x02ABA; - "succneqq", `One 0x02AB6; - "succnsim", `One 0x022E9; - "succsim", `One 0x0227F; - "SuchThat", `One 0x0220B; - "Sum", `One 0x02211; - "sum", `One 0x02211; - "sung", `One 0x0266A; - "Sup", `One 0x022D1; - "sup", `One 0x02283; - "sup1", `One 0x000B9; - "sup", `One 0x000B9; - "sup2", `One 0x000B2; - "sup", `One 0x000B2; - "sup3", `One 0x000B3; - "sup", `One 0x000B3; - "supdot", `One 0x02ABE; - "supdsub", `One 0x02AD8; - "supE", `One 0x02AC6; - "supe", `One 0x02287; - "supedot", `One 0x02AC4; - "Superset", `One 0x02283; - "SupersetEqual", `One 0x02287; - "suphsol", `One 0x027C9; - "suphsub", `One 0x02AD7; - "suplarr", `One 0x0297B; - "supmult", `One 0x02AC2; - "supnE", `One 0x02ACC; - "supne", `One 0x0228B; - "supplus", `One 0x02AC0; - "Supset", `One 0x022D1; - "supset", `One 0x02283; - "supseteq", `One 0x02287; - "supseteqq", `One 0x02AC6; - "supsetneq", `One 0x0228B; - "supsetneqq", `One 0x02ACC; - "supsim", `One 0x02AC8; - "supsub", `One 0x02AD4; - "supsup", `One 0x02AD6; - "swarhk", `One 0x02926; - "swArr", `One 0x021D9; - "swarr", `One 0x02199; - "swarrow", `One 0x02199; - "swnwar", `One 0x0292A; - "szlig", `One 0x000DF; - "szli", `One 0x000DF; - "Tab", `One 0x00009; - "target", `One 0x02316; - "Tau", `One 0x003A4; - "tau", `One 0x003C4; - "tbrk", `One 0x023B4; - "Tcaron", `One 0x00164; - "tcaron", `One 0x00165; - "Tcedil", `One 0x00162; - "tcedil", `One 0x00163; - "Tcy", `One 0x00422; - "tcy", `One 0x00442; - "tdot", `One 0x020DB; - "telrec", `One 0x02315; - "Tfr", `One 0x1D517; - "tfr", `One 0x1D531; - "there4", `One 0x02234; - "Therefore", `One 0x02234; - "therefore", `One 0x02234; - "Theta", `One 0x00398; - "theta", `One 0x003B8; - "thetasym", `One 0x003D1; - "thetav", `One 0x003D1; - "thickapprox", `One 0x02248; - "thicksim", `One 0x0223C; - "ThickSpace", `Two (0x0205F, 0x0200A); - "thinsp", `One 0x02009; - "ThinSpace", `One 0x02009; - "thkap", `One 0x02248; - "thksim", `One 0x0223C; - "THORN", `One 0x000DE; - "THOR", `One 0x000DE; - "thorn", `One 0x000FE; - "thor", `One 0x000FE; - "Tilde", `One 0x0223C; - "tilde", `One 0x002DC; - "TildeEqual", `One 0x02243; - "TildeFullEqual", `One 0x02245; - "TildeTilde", `One 0x02248; - "times", `One 0x000D7; - "time", `One 0x000D7; - "timesb", `One 0x022A0; - "timesbar", `One 0x02A31; - "timesd", `One 0x02A30; - "tint", `One 0x0222D; - "toea", `One 0x02928; - "top", `One 0x022A4; - "topbot", `One 0x02336; - "topcir", `One 0x02AF1; - "Topf", `One 0x1D54B; - "topf", `One 0x1D565; - "topfork", `One 0x02ADA; - "tosa", `One 0x02929; - "tprime", `One 0x02034; - "TRADE", `One 0x02122; - "trade", `One 0x02122; - "triangle", `One 0x025B5; - "triangledown", `One 0x025BF; - "triangleleft", `One 0x025C3; - "trianglelefteq", `One 0x022B4; - "triangleq", `One 0x0225C; - "triangleright", `One 0x025B9; - "trianglerighteq", `One 0x022B5; - "tridot", `One 0x025EC; - "trie", `One 0x0225C; - "triminus", `One 0x02A3A; - "TripleDot", `One 0x020DB; - "triplus", `One 0x02A39; - "trisb", `One 0x029CD; - "tritime", `One 0x02A3B; - "trpezium", `One 0x023E2; - "Tscr", `One 0x1D4AF; - "tscr", `One 0x1D4C9; - "TScy", `One 0x00426; - "tscy", `One 0x00446; - "TSHcy", `One 0x0040B; - "tshcy", `One 0x0045B; - "Tstrok", `One 0x00166; - "tstrok", `One 0x00167; - "twixt", `One 0x0226C; - "twoheadleftarrow", `One 0x0219E; - "twoheadrightarrow", `One 0x021A0; - "Uacute", `One 0x000DA; - "Uacut", `One 0x000DA; - "uacute", `One 0x000FA; - "uacut", `One 0x000FA; - "Uarr", `One 0x0219F; - "uArr", `One 0x021D1; - "uarr", `One 0x02191; - "Uarrocir", `One 0x02949; - "Ubrcy", `One 0x0040E; - "ubrcy", `One 0x0045E; - "Ubreve", `One 0x0016C; - "ubreve", `One 0x0016D; - "Ucirc", `One 0x000DB; - "Ucir", `One 0x000DB; - "ucirc", `One 0x000FB; - "ucir", `One 0x000FB; - "Ucy", `One 0x00423; - "ucy", `One 0x00443; - "udarr", `One 0x021C5; - "Udblac", `One 0x00170; - "udblac", `One 0x00171; - "udhar", `One 0x0296E; - "ufisht", `One 0x0297E; - "Ufr", `One 0x1D518; - "ufr", `One 0x1D532; - "Ugrave", `One 0x000D9; - "Ugrav", `One 0x000D9; - "ugrave", `One 0x000F9; - "ugrav", `One 0x000F9; - "uHar", `One 0x02963; - "uharl", `One 0x021BF; - "uharr", `One 0x021BE; - "uhblk", `One 0x02580; - "ulcorn", `One 0x0231C; - "ulcorner", `One 0x0231C; - "ulcrop", `One 0x0230F; - "ultri", `One 0x025F8; - "Umacr", `One 0x0016A; - "umacr", `One 0x0016B; - "uml", `One 0x000A8; - "um", `One 0x000A8; - "UnderBar", `One 0x0005F; - "UnderBrace", `One 0x023DF; - "UnderBracket", `One 0x023B5; - "UnderParenthesis", `One 0x023DD; - "Union", `One 0x022C3; - "UnionPlus", `One 0x0228E; - "Uogon", `One 0x00172; - "uogon", `One 0x00173; - "Uopf", `One 0x1D54C; - "uopf", `One 0x1D566; - "UpArrow", `One 0x02191; - "Uparrow", `One 0x021D1; - "uparrow", `One 0x02191; - "UpArrowBar", `One 0x02912; - "UpArrowDownArrow", `One 0x021C5; - "UpDownArrow", `One 0x02195; - "Updownarrow", `One 0x021D5; - "updownarrow", `One 0x02195; - "UpEquilibrium", `One 0x0296E; - "upharpoonleft", `One 0x021BF; - "upharpoonright", `One 0x021BE; - "uplus", `One 0x0228E; - "UpperLeftArrow", `One 0x02196; - "UpperRightArrow", `One 0x02197; - "Upsi", `One 0x003D2; - "upsi", `One 0x003C5; - "upsih", `One 0x003D2; - "Upsilon", `One 0x003A5; - "upsilon", `One 0x003C5; - "UpTee", `One 0x022A5; - "UpTeeArrow", `One 0x021A5; - "upuparrows", `One 0x021C8; - "urcorn", `One 0x0231D; - "urcorner", `One 0x0231D; - "urcrop", `One 0x0230E; - "Uring", `One 0x0016E; - "uring", `One 0x0016F; - "urtri", `One 0x025F9; - "Uscr", `One 0x1D4B0; - "uscr", `One 0x1D4CA; - "utdot", `One 0x022F0; - "Utilde", `One 0x00168; - "utilde", `One 0x00169; - "utri", `One 0x025B5; - "utrif", `One 0x025B4; - "uuarr", `One 0x021C8; - "Uuml", `One 0x000DC; - "Uum", `One 0x000DC; - "uuml", `One 0x000FC; - "uum", `One 0x000FC; - "uwangle", `One 0x029A7; - "vangrt", `One 0x0299C; - "varepsilon", `One 0x003F5; - "varkappa", `One 0x003F0; - "varnothing", `One 0x02205; - "varphi", `One 0x003D5; - "varpi", `One 0x003D6; - "varpropto", `One 0x0221D; - "vArr", `One 0x021D5; - "varr", `One 0x02195; - "varrho", `One 0x003F1; - "varsigma", `One 0x003C2; - "varsubsetneq", `Two (0x0228A, 0x0FE00); - "varsubsetneqq", `Two (0x02ACB, 0x0FE00); - "varsupsetneq", `Two (0x0228B, 0x0FE00); - "varsupsetneqq", `Two (0x02ACC, 0x0FE00); - "vartheta", `One 0x003D1; - "vartriangleleft", `One 0x022B2; - "vartriangleright", `One 0x022B3; - "Vbar", `One 0x02AEB; - "vBar", `One 0x02AE8; - "vBarv", `One 0x02AE9; - "Vcy", `One 0x00412; - "vcy", `One 0x00432; - "VDash", `One 0x022AB; - "Vdash", `One 0x022A9; - "vDash", `One 0x022A8; - "vdash", `One 0x022A2; - "Vdashl", `One 0x02AE6; - "Vee", `One 0x022C1; - "vee", `One 0x02228; - "veebar", `One 0x022BB; - "veeeq", `One 0x0225A; - "vellip", `One 0x022EE; - "Verbar", `One 0x02016; - "verbar", `One 0x0007C; - "Vert", `One 0x02016; - "vert", `One 0x0007C; - "VerticalBar", `One 0x02223; - "VerticalLine", `One 0x0007C; - "VerticalSeparator", `One 0x02758; - "VerticalTilde", `One 0x02240; - "VeryThinSpace", `One 0x0200A; - "Vfr", `One 0x1D519; - "vfr", `One 0x1D533; - "vltri", `One 0x022B2; - "vnsub", `Two (0x02282, 0x020D2); - "vnsup", `Two (0x02283, 0x020D2); - "Vopf", `One 0x1D54D; - "vopf", `One 0x1D567; - "vprop", `One 0x0221D; - "vrtri", `One 0x022B3; - "Vscr", `One 0x1D4B1; - "vscr", `One 0x1D4CB; - "vsubnE", `Two (0x02ACB, 0x0FE00); - "vsubne", `Two (0x0228A, 0x0FE00); - "vsupnE", `Two (0x02ACC, 0x0FE00); - "vsupne", `Two (0x0228B, 0x0FE00); - "Vvdash", `One 0x022AA; - "vzigzag", `One 0x0299A; - "Wcirc", `One 0x00174; - "wcirc", `One 0x00175; - "wedbar", `One 0x02A5F; - "Wedge", `One 0x022C0; - "wedge", `One 0x02227; - "wedgeq", `One 0x02259; - "weierp", `One 0x02118; - "Wfr", `One 0x1D51A; - "wfr", `One 0x1D534; - "Wopf", `One 0x1D54E; - "wopf", `One 0x1D568; - "wp", `One 0x02118; - "wr", `One 0x02240; - "wreath", `One 0x02240; - "Wscr", `One 0x1D4B2; - "wscr", `One 0x1D4CC; - "xcap", `One 0x022C2; - "xcirc", `One 0x025EF; - "xcup", `One 0x022C3; - "xdtri", `One 0x025BD; - "Xfr", `One 0x1D51B; - "xfr", `One 0x1D535; - "xhArr", `One 0x027FA; - "xharr", `One 0x027F7; - "Xi", `One 0x0039E; - "xi", `One 0x003BE; - "xlArr", `One 0x027F8; - "xlarr", `One 0x027F5; - "xmap", `One 0x027FC; - "xnis", `One 0x022FB; - "xodot", `One 0x02A00; - "Xopf", `One 0x1D54F; - "xopf", `One 0x1D569; - "xoplus", `One 0x02A01; - "xotime", `One 0x02A02; - "xrArr", `One 0x027F9; - "xrarr", `One 0x027F6; - "Xscr", `One 0x1D4B3; - "xscr", `One 0x1D4CD; - "xsqcup", `One 0x02A06; - "xuplus", `One 0x02A04; - "xutri", `One 0x025B3; - "xvee", `One 0x022C1; - "xwedge", `One 0x022C0; - "Yacute", `One 0x000DD; - "Yacut", `One 0x000DD; - "yacute", `One 0x000FD; - "yacut", `One 0x000FD; - "YAcy", `One 0x0042F; - "yacy", `One 0x0044F; - "Ycirc", `One 0x00176; - "ycirc", `One 0x00177; - "Ycy", `One 0x0042B; - "ycy", `One 0x0044B; - "yen", `One 0x000A5; - "ye", `One 0x000A5; - "Yfr", `One 0x1D51C; - "yfr", `One 0x1D536; - "YIcy", `One 0x00407; - "yicy", `One 0x00457; - "Yopf", `One 0x1D550; - "yopf", `One 0x1D56A; - "Yscr", `One 0x1D4B4; - "yscr", `One 0x1D4CE; - "YUcy", `One 0x0042E; - "yucy", `One 0x0044E; - "Yuml", `One 0x00178; - "yuml", `One 0x000FF; - "yum", `One 0x000FF; - "Zacute", `One 0x00179; - "zacute", `One 0x0017A; - "Zcaron", `One 0x0017D; - "zcaron", `One 0x0017E; - "Zcy", `One 0x00417; - "zcy", `One 0x00437; - "Zdot", `One 0x0017B; - "zdot", `One 0x0017C; - "zeetrf", `One 0x02128; - "ZeroWidthSpace", `One 0x0200B; - "Zeta", `One 0x00396; - "zeta", `One 0x003B6; - "Zfr", `One 0x02128; - "zfr", `One 0x1D537; - "ZHcy", `One 0x00416; - "zhcy", `One 0x00436; - "zigrarr", `One 0x021DD; - "Zopf", `One 0x02124; - "zopf", `One 0x1D56B; - "Zscr", `One 0x1D4B5; - "zscr", `One 0x1D4CF; - "zwj", `One 0x0200D; - "zwnj", `One 0x0200C -|] +include Markup_entities.Entities diff --git a/src/entities/dune b/src/entities/dune new file mode 100644 index 0000000..d2cd155 --- /dev/null +++ b/src/entities/dune @@ -0,0 +1,8 @@ +(library + (name markup_entities) + (public_name markup.entities) + (synopsis "HTML character entity table and lookup trie for Markup.ml") + (instrumentation + (backend bisect_ppx)) + (flags + (:standard -w -9))) diff --git a/src/entities.json b/src/entities/entities.json similarity index 100% rename from src/entities.json rename to src/entities/entities.json diff --git a/src/entities/entities.ml b/src/entities/entities.ml new file mode 100644 index 0000000..6e5c298 --- /dev/null +++ b/src/entities/entities.ml @@ -0,0 +1,2239 @@ +(* Copyright © 2014 W3C® (MIT, ERCIM, Keio, Beihang). This software or document + includes material copied from or derived from W3C Recommendation HTML5 + [https://www.w3.org/TR/2014/REC-html5-20141028/]. *) + +(* Generated automatically from entities.json. *) + +let entities : (string * [ `One of int | `Two of int * int ]) array = [| + "Aacute", `One 0x000C1; + "Aacut", `One 0x000C1; + "aacute", `One 0x000E1; + "aacut", `One 0x000E1; + "Abreve", `One 0x00102; + "abreve", `One 0x00103; + "ac", `One 0x0223E; + "acd", `One 0x0223F; + "acE", `Two (0x0223E, 0x00333); + "Acirc", `One 0x000C2; + "Acir", `One 0x000C2; + "acirc", `One 0x000E2; + "acir", `One 0x000E2; + "acute", `One 0x000B4; + "acut", `One 0x000B4; + "Acy", `One 0x00410; + "acy", `One 0x00430; + "AElig", `One 0x000C6; + "AEli", `One 0x000C6; + "aelig", `One 0x000E6; + "aeli", `One 0x000E6; + "af", `One 0x02061; + "Afr", `One 0x1D504; + "afr", `One 0x1D51E; + "Agrave", `One 0x000C0; + "Agrav", `One 0x000C0; + "agrave", `One 0x000E0; + "agrav", `One 0x000E0; + "alefsym", `One 0x02135; + "aleph", `One 0x02135; + "Alpha", `One 0x00391; + "alpha", `One 0x003B1; + "Amacr", `One 0x00100; + "amacr", `One 0x00101; + "amalg", `One 0x02A3F; + "AMP", `One 0x00026; + "AM", `One 0x00026; + "amp", `One 0x00026; + "am", `One 0x00026; + "And", `One 0x02A53; + "and", `One 0x02227; + "andand", `One 0x02A55; + "andd", `One 0x02A5C; + "andslope", `One 0x02A58; + "andv", `One 0x02A5A; + "ang", `One 0x02220; + "ange", `One 0x029A4; + "angle", `One 0x02220; + "angmsd", `One 0x02221; + "angmsdaa", `One 0x029A8; + "angmsdab", `One 0x029A9; + "angmsdac", `One 0x029AA; + "angmsdad", `One 0x029AB; + "angmsdae", `One 0x029AC; + "angmsdaf", `One 0x029AD; + "angmsdag", `One 0x029AE; + "angmsdah", `One 0x029AF; + "angrt", `One 0x0221F; + "angrtvb", `One 0x022BE; + "angrtvbd", `One 0x0299D; + "angsph", `One 0x02222; + "angst", `One 0x000C5; + "angzarr", `One 0x0237C; + "Aogon", `One 0x00104; + "aogon", `One 0x00105; + "Aopf", `One 0x1D538; + "aopf", `One 0x1D552; + "ap", `One 0x02248; + "apacir", `One 0x02A6F; + "apE", `One 0x02A70; + "ape", `One 0x0224A; + "apid", `One 0x0224B; + "apos", `One 0x00027; + "ApplyFunction", `One 0x02061; + "approx", `One 0x02248; + "approxeq", `One 0x0224A; + "Aring", `One 0x000C5; + "Arin", `One 0x000C5; + "aring", `One 0x000E5; + "arin", `One 0x000E5; + "Ascr", `One 0x1D49C; + "ascr", `One 0x1D4B6; + "Assign", `One 0x02254; + "ast", `One 0x0002A; + "asymp", `One 0x02248; + "asympeq", `One 0x0224D; + "Atilde", `One 0x000C3; + "Atild", `One 0x000C3; + "atilde", `One 0x000E3; + "atild", `One 0x000E3; + "Auml", `One 0x000C4; + "Aum", `One 0x000C4; + "auml", `One 0x000E4; + "aum", `One 0x000E4; + "awconint", `One 0x02233; + "awint", `One 0x02A11; + "backcong", `One 0x0224C; + "backepsilon", `One 0x003F6; + "backprime", `One 0x02035; + "backsim", `One 0x0223D; + "backsimeq", `One 0x022CD; + "Backslash", `One 0x02216; + "Barv", `One 0x02AE7; + "barvee", `One 0x022BD; + "Barwed", `One 0x02306; + "barwed", `One 0x02305; + "barwedge", `One 0x02305; + "bbrk", `One 0x023B5; + "bbrktbrk", `One 0x023B6; + "bcong", `One 0x0224C; + "Bcy", `One 0x00411; + "bcy", `One 0x00431; + "bdquo", `One 0x0201E; + "becaus", `One 0x02235; + "Because", `One 0x02235; + "because", `One 0x02235; + "bemptyv", `One 0x029B0; + "bepsi", `One 0x003F6; + "bernou", `One 0x0212C; + "Bernoullis", `One 0x0212C; + "Beta", `One 0x00392; + "beta", `One 0x003B2; + "beth", `One 0x02136; + "between", `One 0x0226C; + "Bfr", `One 0x1D505; + "bfr", `One 0x1D51F; + "bigcap", `One 0x022C2; + "bigcirc", `One 0x025EF; + "bigcup", `One 0x022C3; + "bigodot", `One 0x02A00; + "bigoplus", `One 0x02A01; + "bigotimes", `One 0x02A02; + "bigsqcup", `One 0x02A06; + "bigstar", `One 0x02605; + "bigtriangledown", `One 0x025BD; + "bigtriangleup", `One 0x025B3; + "biguplus", `One 0x02A04; + "bigvee", `One 0x022C1; + "bigwedge", `One 0x022C0; + "bkarow", `One 0x0290D; + "blacklozenge", `One 0x029EB; + "blacksquare", `One 0x025AA; + "blacktriangle", `One 0x025B4; + "blacktriangledown", `One 0x025BE; + "blacktriangleleft", `One 0x025C2; + "blacktriangleright", `One 0x025B8; + "blank", `One 0x02423; + "blk12", `One 0x02592; + "blk14", `One 0x02591; + "blk34", `One 0x02593; + "block", `One 0x02588; + "bne", `Two (0x0003D, 0x020E5); + "bnequiv", `Two (0x02261, 0x020E5); + "bNot", `One 0x02AED; + "bnot", `One 0x02310; + "Bopf", `One 0x1D539; + "bopf", `One 0x1D553; + "bot", `One 0x022A5; + "bottom", `One 0x022A5; + "bowtie", `One 0x022C8; + "boxbox", `One 0x029C9; + "boxDL", `One 0x02557; + "boxDl", `One 0x02556; + "boxdL", `One 0x02555; + "boxdl", `One 0x02510; + "boxDR", `One 0x02554; + "boxDr", `One 0x02553; + "boxdR", `One 0x02552; + "boxdr", `One 0x0250C; + "boxH", `One 0x02550; + "boxh", `One 0x02500; + "boxHD", `One 0x02566; + "boxHd", `One 0x02564; + "boxhD", `One 0x02565; + "boxhd", `One 0x0252C; + "boxHU", `One 0x02569; + "boxHu", `One 0x02567; + "boxhU", `One 0x02568; + "boxhu", `One 0x02534; + "boxminus", `One 0x0229F; + "boxplus", `One 0x0229E; + "boxtimes", `One 0x022A0; + "boxUL", `One 0x0255D; + "boxUl", `One 0x0255C; + "boxuL", `One 0x0255B; + "boxul", `One 0x02518; + "boxUR", `One 0x0255A; + "boxUr", `One 0x02559; + "boxuR", `One 0x02558; + "boxur", `One 0x02514; + "boxV", `One 0x02551; + "boxv", `One 0x02502; + "boxVH", `One 0x0256C; + "boxVh", `One 0x0256B; + "boxvH", `One 0x0256A; + "boxvh", `One 0x0253C; + "boxVL", `One 0x02563; + "boxVl", `One 0x02562; + "boxvL", `One 0x02561; + "boxvl", `One 0x02524; + "boxVR", `One 0x02560; + "boxVr", `One 0x0255F; + "boxvR", `One 0x0255E; + "boxvr", `One 0x0251C; + "bprime", `One 0x02035; + "Breve", `One 0x002D8; + "breve", `One 0x002D8; + "brvbar", `One 0x000A6; + "brvba", `One 0x000A6; + "Bscr", `One 0x0212C; + "bscr", `One 0x1D4B7; + "bsemi", `One 0x0204F; + "bsim", `One 0x0223D; + "bsime", `One 0x022CD; + "bsol", `One 0x0005C; + "bsolb", `One 0x029C5; + "bsolhsub", `One 0x027C8; + "bull", `One 0x02022; + "bullet", `One 0x02022; + "bump", `One 0x0224E; + "bumpE", `One 0x02AAE; + "bumpe", `One 0x0224F; + "Bumpeq", `One 0x0224E; + "bumpeq", `One 0x0224F; + "Cacute", `One 0x00106; + "cacute", `One 0x00107; + "Cap", `One 0x022D2; + "cap", `One 0x02229; + "capand", `One 0x02A44; + "capbrcup", `One 0x02A49; + "capcap", `One 0x02A4B; + "capcup", `One 0x02A47; + "capdot", `One 0x02A40; + "CapitalDifferentialD", `One 0x02145; + "caps", `Two (0x02229, 0x0FE00); + "caret", `One 0x02041; + "caron", `One 0x002C7; + "Cayleys", `One 0x0212D; + "ccaps", `One 0x02A4D; + "Ccaron", `One 0x0010C; + "ccaron", `One 0x0010D; + "Ccedil", `One 0x000C7; + "Ccedi", `One 0x000C7; + "ccedil", `One 0x000E7; + "ccedi", `One 0x000E7; + "Ccirc", `One 0x00108; + "ccirc", `One 0x00109; + "Cconint", `One 0x02230; + "ccups", `One 0x02A4C; + "ccupssm", `One 0x02A50; + "Cdot", `One 0x0010A; + "cdot", `One 0x0010B; + "cedil", `One 0x000B8; + "cedi", `One 0x000B8; + "Cedilla", `One 0x000B8; + "cemptyv", `One 0x029B2; + "cent", `One 0x000A2; + "cen", `One 0x000A2; + "CenterDot", `One 0x000B7; + "centerdot", `One 0x000B7; + "Cfr", `One 0x0212D; + "cfr", `One 0x1D520; + "CHcy", `One 0x00427; + "chcy", `One 0x00447; + "check", `One 0x02713; + "checkmark", `One 0x02713; + "Chi", `One 0x003A7; + "chi", `One 0x003C7; + "cir", `One 0x025CB; + "circ", `One 0x002C6; + "circeq", `One 0x02257; + "circlearrowleft", `One 0x021BA; + "circlearrowright", `One 0x021BB; + "circledast", `One 0x0229B; + "circledcirc", `One 0x0229A; + "circleddash", `One 0x0229D; + "CircleDot", `One 0x02299; + "circledR", `One 0x000AE; + "circledS", `One 0x024C8; + "CircleMinus", `One 0x02296; + "CirclePlus", `One 0x02295; + "CircleTimes", `One 0x02297; + "cirE", `One 0x029C3; + "cire", `One 0x02257; + "cirfnint", `One 0x02A10; + "cirmid", `One 0x02AEF; + "cirscir", `One 0x029C2; + "ClockwiseContourIntegral", `One 0x02232; + "CloseCurlyDoubleQuote", `One 0x0201D; + "CloseCurlyQuote", `One 0x02019; + "clubs", `One 0x02663; + "clubsuit", `One 0x02663; + "Colon", `One 0x02237; + "colon", `One 0x0003A; + "Colone", `One 0x02A74; + "colone", `One 0x02254; + "coloneq", `One 0x02254; + "comma", `One 0x0002C; + "commat", `One 0x00040; + "comp", `One 0x02201; + "compfn", `One 0x02218; + "complement", `One 0x02201; + "complexes", `One 0x02102; + "cong", `One 0x02245; + "congdot", `One 0x02A6D; + "Congruent", `One 0x02261; + "Conint", `One 0x0222F; + "conint", `One 0x0222E; + "ContourIntegral", `One 0x0222E; + "Copf", `One 0x02102; + "copf", `One 0x1D554; + "coprod", `One 0x02210; + "Coproduct", `One 0x02210; + "COPY", `One 0x000A9; + "COP", `One 0x000A9; + "copy", `One 0x000A9; + "cop", `One 0x000A9; + "copysr", `One 0x02117; + "CounterClockwiseContourIntegral", `One 0x02233; + "crarr", `One 0x021B5; + "Cross", `One 0x02A2F; + "cross", `One 0x02717; + "Cscr", `One 0x1D49E; + "cscr", `One 0x1D4B8; + "csub", `One 0x02ACF; + "csube", `One 0x02AD1; + "csup", `One 0x02AD0; + "csupe", `One 0x02AD2; + "ctdot", `One 0x022EF; + "cudarrl", `One 0x02938; + "cudarrr", `One 0x02935; + "cuepr", `One 0x022DE; + "cuesc", `One 0x022DF; + "cularr", `One 0x021B6; + "cularrp", `One 0x0293D; + "Cup", `One 0x022D3; + "cup", `One 0x0222A; + "cupbrcap", `One 0x02A48; + "CupCap", `One 0x0224D; + "cupcap", `One 0x02A46; + "cupcup", `One 0x02A4A; + "cupdot", `One 0x0228D; + "cupor", `One 0x02A45; + "cups", `Two (0x0222A, 0x0FE00); + "curarr", `One 0x021B7; + "curarrm", `One 0x0293C; + "curlyeqprec", `One 0x022DE; + "curlyeqsucc", `One 0x022DF; + "curlyvee", `One 0x022CE; + "curlywedge", `One 0x022CF; + "curren", `One 0x000A4; + "curre", `One 0x000A4; + "curvearrowleft", `One 0x021B6; + "curvearrowright", `One 0x021B7; + "cuvee", `One 0x022CE; + "cuwed", `One 0x022CF; + "cwconint", `One 0x02232; + "cwint", `One 0x02231; + "cylcty", `One 0x0232D; + "Dagger", `One 0x02021; + "dagger", `One 0x02020; + "daleth", `One 0x02138; + "Darr", `One 0x021A1; + "dArr", `One 0x021D3; + "darr", `One 0x02193; + "dash", `One 0x02010; + "Dashv", `One 0x02AE4; + "dashv", `One 0x022A3; + "dbkarow", `One 0x0290F; + "dblac", `One 0x002DD; + "Dcaron", `One 0x0010E; + "dcaron", `One 0x0010F; + "Dcy", `One 0x00414; + "dcy", `One 0x00434; + "DD", `One 0x02145; + "dd", `One 0x02146; + "ddagger", `One 0x02021; + "ddarr", `One 0x021CA; + "DDotrahd", `One 0x02911; + "ddotseq", `One 0x02A77; + "deg", `One 0x000B0; + "de", `One 0x000B0; + "Del", `One 0x02207; + "Delta", `One 0x00394; + "delta", `One 0x003B4; + "demptyv", `One 0x029B1; + "dfisht", `One 0x0297F; + "Dfr", `One 0x1D507; + "dfr", `One 0x1D521; + "dHar", `One 0x02965; + "dharl", `One 0x021C3; + "dharr", `One 0x021C2; + "DiacriticalAcute", `One 0x000B4; + "DiacriticalDot", `One 0x002D9; + "DiacriticalDoubleAcute", `One 0x002DD; + "DiacriticalGrave", `One 0x00060; + "DiacriticalTilde", `One 0x002DC; + "diam", `One 0x022C4; + "Diamond", `One 0x022C4; + "diamond", `One 0x022C4; + "diamondsuit", `One 0x02666; + "diams", `One 0x02666; + "die", `One 0x000A8; + "DifferentialD", `One 0x02146; + "digamma", `One 0x003DD; + "disin", `One 0x022F2; + "div", `One 0x000F7; + "divide", `One 0x000F7; + "divid", `One 0x000F7; + "divideontimes", `One 0x022C7; + "divonx", `One 0x022C7; + "DJcy", `One 0x00402; + "djcy", `One 0x00452; + "dlcorn", `One 0x0231E; + "dlcrop", `One 0x0230D; + "dollar", `One 0x00024; + "Dopf", `One 0x1D53B; + "dopf", `One 0x1D555; + "Dot", `One 0x000A8; + "dot", `One 0x002D9; + "DotDot", `One 0x020DC; + "doteq", `One 0x02250; + "doteqdot", `One 0x02251; + "DotEqual", `One 0x02250; + "dotminus", `One 0x02238; + "dotplus", `One 0x02214; + "dotsquare", `One 0x022A1; + "doublebarwedge", `One 0x02306; + "DoubleContourIntegral", `One 0x0222F; + "DoubleDot", `One 0x000A8; + "DoubleDownArrow", `One 0x021D3; + "DoubleLeftArrow", `One 0x021D0; + "DoubleLeftRightArrow", `One 0x021D4; + "DoubleLeftTee", `One 0x02AE4; + "DoubleLongLeftArrow", `One 0x027F8; + "DoubleLongLeftRightArrow", `One 0x027FA; + "DoubleLongRightArrow", `One 0x027F9; + "DoubleRightArrow", `One 0x021D2; + "DoubleRightTee", `One 0x022A8; + "DoubleUpArrow", `One 0x021D1; + "DoubleUpDownArrow", `One 0x021D5; + "DoubleVerticalBar", `One 0x02225; + "DownArrow", `One 0x02193; + "Downarrow", `One 0x021D3; + "downarrow", `One 0x02193; + "DownArrowBar", `One 0x02913; + "DownArrowUpArrow", `One 0x021F5; + "DownBreve", `One 0x00311; + "downdownarrows", `One 0x021CA; + "downharpoonleft", `One 0x021C3; + "downharpoonright", `One 0x021C2; + "DownLeftRightVector", `One 0x02950; + "DownLeftTeeVector", `One 0x0295E; + "DownLeftVector", `One 0x021BD; + "DownLeftVectorBar", `One 0x02956; + "DownRightTeeVector", `One 0x0295F; + "DownRightVector", `One 0x021C1; + "DownRightVectorBar", `One 0x02957; + "DownTee", `One 0x022A4; + "DownTeeArrow", `One 0x021A7; + "drbkarow", `One 0x02910; + "drcorn", `One 0x0231F; + "drcrop", `One 0x0230C; + "Dscr", `One 0x1D49F; + "dscr", `One 0x1D4B9; + "DScy", `One 0x00405; + "dscy", `One 0x00455; + "dsol", `One 0x029F6; + "Dstrok", `One 0x00110; + "dstrok", `One 0x00111; + "dtdot", `One 0x022F1; + "dtri", `One 0x025BF; + "dtrif", `One 0x025BE; + "duarr", `One 0x021F5; + "duhar", `One 0x0296F; + "dwangle", `One 0x029A6; + "DZcy", `One 0x0040F; + "dzcy", `One 0x0045F; + "dzigrarr", `One 0x027FF; + "Eacute", `One 0x000C9; + "Eacut", `One 0x000C9; + "eacute", `One 0x000E9; + "eacut", `One 0x000E9; + "easter", `One 0x02A6E; + "Ecaron", `One 0x0011A; + "ecaron", `One 0x0011B; + "ecir", `One 0x02256; + "Ecirc", `One 0x000CA; + "Ecir", `One 0x000CA; + "ecirc", `One 0x000EA; + "ecir", `One 0x000EA; + "ecolon", `One 0x02255; + "Ecy", `One 0x0042D; + "ecy", `One 0x0044D; + "eDDot", `One 0x02A77; + "Edot", `One 0x00116; + "eDot", `One 0x02251; + "edot", `One 0x00117; + "ee", `One 0x02147; + "efDot", `One 0x02252; + "Efr", `One 0x1D508; + "efr", `One 0x1D522; + "eg", `One 0x02A9A; + "Egrave", `One 0x000C8; + "Egrav", `One 0x000C8; + "egrave", `One 0x000E8; + "egrav", `One 0x000E8; + "egs", `One 0x02A96; + "egsdot", `One 0x02A98; + "el", `One 0x02A99; + "Element", `One 0x02208; + "elinters", `One 0x023E7; + "ell", `One 0x02113; + "els", `One 0x02A95; + "elsdot", `One 0x02A97; + "Emacr", `One 0x00112; + "emacr", `One 0x00113; + "empty", `One 0x02205; + "emptyset", `One 0x02205; + "EmptySmallSquare", `One 0x025FB; + "emptyv", `One 0x02205; + "EmptyVerySmallSquare", `One 0x025AB; + "emsp", `One 0x02003; + "emsp13", `One 0x02004; + "emsp14", `One 0x02005; + "ENG", `One 0x0014A; + "eng", `One 0x0014B; + "ensp", `One 0x02002; + "Eogon", `One 0x00118; + "eogon", `One 0x00119; + "Eopf", `One 0x1D53C; + "eopf", `One 0x1D556; + "epar", `One 0x022D5; + "eparsl", `One 0x029E3; + "eplus", `One 0x02A71; + "epsi", `One 0x003B5; + "Epsilon", `One 0x00395; + "epsilon", `One 0x003B5; + "epsiv", `One 0x003F5; + "eqcirc", `One 0x02256; + "eqcolon", `One 0x02255; + "eqsim", `One 0x02242; + "eqslantgtr", `One 0x02A96; + "eqslantless", `One 0x02A95; + "Equal", `One 0x02A75; + "equals", `One 0x0003D; + "EqualTilde", `One 0x02242; + "equest", `One 0x0225F; + "Equilibrium", `One 0x021CC; + "equiv", `One 0x02261; + "equivDD", `One 0x02A78; + "eqvparsl", `One 0x029E5; + "erarr", `One 0x02971; + "erDot", `One 0x02253; + "Escr", `One 0x02130; + "escr", `One 0x0212F; + "esdot", `One 0x02250; + "Esim", `One 0x02A73; + "esim", `One 0x02242; + "Eta", `One 0x00397; + "eta", `One 0x003B7; + "ETH", `One 0x000D0; + "ET", `One 0x000D0; + "eth", `One 0x000F0; + "et", `One 0x000F0; + "Euml", `One 0x000CB; + "Eum", `One 0x000CB; + "euml", `One 0x000EB; + "eum", `One 0x000EB; + "euro", `One 0x020AC; + "excl", `One 0x00021; + "exist", `One 0x02203; + "Exists", `One 0x02203; + "expectation", `One 0x02130; + "ExponentialE", `One 0x02147; + "exponentiale", `One 0x02147; + "fallingdotseq", `One 0x02252; + "Fcy", `One 0x00424; + "fcy", `One 0x00444; + "female", `One 0x02640; + "ffilig", `One 0x0FB03; + "fflig", `One 0x0FB00; + "ffllig", `One 0x0FB04; + "Ffr", `One 0x1D509; + "ffr", `One 0x1D523; + "filig", `One 0x0FB01; + "FilledSmallSquare", `One 0x025FC; + "FilledVerySmallSquare", `One 0x025AA; + "fjlig", `Two (0x00066, 0x0006A); + "flat", `One 0x0266D; + "fllig", `One 0x0FB02; + "fltns", `One 0x025B1; + "fnof", `One 0x00192; + "Fopf", `One 0x1D53D; + "fopf", `One 0x1D557; + "ForAll", `One 0x02200; + "forall", `One 0x02200; + "fork", `One 0x022D4; + "forkv", `One 0x02AD9; + "Fouriertrf", `One 0x02131; + "fpartint", `One 0x02A0D; + "frac12", `One 0x000BD; + "frac1", `One 0x000BD; + "frac13", `One 0x02153; + "frac14", `One 0x000BC; + "frac1", `One 0x000BC; + "frac15", `One 0x02155; + "frac16", `One 0x02159; + "frac18", `One 0x0215B; + "frac23", `One 0x02154; + "frac25", `One 0x02156; + "frac34", `One 0x000BE; + "frac3", `One 0x000BE; + "frac35", `One 0x02157; + "frac38", `One 0x0215C; + "frac45", `One 0x02158; + "frac56", `One 0x0215A; + "frac58", `One 0x0215D; + "frac78", `One 0x0215E; + "frasl", `One 0x02044; + "frown", `One 0x02322; + "Fscr", `One 0x02131; + "fscr", `One 0x1D4BB; + "gacute", `One 0x001F5; + "Gamma", `One 0x00393; + "gamma", `One 0x003B3; + "Gammad", `One 0x003DC; + "gammad", `One 0x003DD; + "gap", `One 0x02A86; + "Gbreve", `One 0x0011E; + "gbreve", `One 0x0011F; + "Gcedil", `One 0x00122; + "Gcirc", `One 0x0011C; + "gcirc", `One 0x0011D; + "Gcy", `One 0x00413; + "gcy", `One 0x00433; + "Gdot", `One 0x00120; + "gdot", `One 0x00121; + "gE", `One 0x02267; + "ge", `One 0x02265; + "gEl", `One 0x02A8C; + "gel", `One 0x022DB; + "geq", `One 0x02265; + "geqq", `One 0x02267; + "geqslant", `One 0x02A7E; + "ges", `One 0x02A7E; + "gescc", `One 0x02AA9; + "gesdot", `One 0x02A80; + "gesdoto", `One 0x02A82; + "gesdotol", `One 0x02A84; + "gesl", `Two (0x022DB, 0x0FE00); + "gesles", `One 0x02A94; + "Gfr", `One 0x1D50A; + "gfr", `One 0x1D524; + "Gg", `One 0x022D9; + "gg", `One 0x0226B; + "ggg", `One 0x022D9; + "gimel", `One 0x02137; + "GJcy", `One 0x00403; + "gjcy", `One 0x00453; + "gl", `One 0x02277; + "gla", `One 0x02AA5; + "glE", `One 0x02A92; + "glj", `One 0x02AA4; + "gnap", `One 0x02A8A; + "gnapprox", `One 0x02A8A; + "gnE", `One 0x02269; + "gne", `One 0x02A88; + "gneq", `One 0x02A88; + "gneqq", `One 0x02269; + "gnsim", `One 0x022E7; + "Gopf", `One 0x1D53E; + "gopf", `One 0x1D558; + "grave", `One 0x00060; + "GreaterEqual", `One 0x02265; + "GreaterEqualLess", `One 0x022DB; + "GreaterFullEqual", `One 0x02267; + "GreaterGreater", `One 0x02AA2; + "GreaterLess", `One 0x02277; + "GreaterSlantEqual", `One 0x02A7E; + "GreaterTilde", `One 0x02273; + "Gscr", `One 0x1D4A2; + "gscr", `One 0x0210A; + "gsim", `One 0x02273; + "gsime", `One 0x02A8E; + "gsiml", `One 0x02A90; + "GT", `One 0x0003E; + "G", `One 0x0003E; + "Gt", `One 0x0226B; + "gt", `One 0x0003E; + "g", `One 0x0003E; + "gtcc", `One 0x02AA7; + "gtcir", `One 0x02A7A; + "gtdot", `One 0x022D7; + "gtlPar", `One 0x02995; + "gtquest", `One 0x02A7C; + "gtrapprox", `One 0x02A86; + "gtrarr", `One 0x02978; + "gtrdot", `One 0x022D7; + "gtreqless", `One 0x022DB; + "gtreqqless", `One 0x02A8C; + "gtrless", `One 0x02277; + "gtrsim", `One 0x02273; + "gvertneqq", `Two (0x02269, 0x0FE00); + "gvnE", `Two (0x02269, 0x0FE00); + "Hacek", `One 0x002C7; + "hairsp", `One 0x0200A; + "half", `One 0x000BD; + "hamilt", `One 0x0210B; + "HARDcy", `One 0x0042A; + "hardcy", `One 0x0044A; + "hArr", `One 0x021D4; + "harr", `One 0x02194; + "harrcir", `One 0x02948; + "harrw", `One 0x021AD; + "Hat", `One 0x0005E; + "hbar", `One 0x0210F; + "Hcirc", `One 0x00124; + "hcirc", `One 0x00125; + "hearts", `One 0x02665; + "heartsuit", `One 0x02665; + "hellip", `One 0x02026; + "hercon", `One 0x022B9; + "Hfr", `One 0x0210C; + "hfr", `One 0x1D525; + "HilbertSpace", `One 0x0210B; + "hksearow", `One 0x02925; + "hkswarow", `One 0x02926; + "hoarr", `One 0x021FF; + "homtht", `One 0x0223B; + "hookleftarrow", `One 0x021A9; + "hookrightarrow", `One 0x021AA; + "Hopf", `One 0x0210D; + "hopf", `One 0x1D559; + "horbar", `One 0x02015; + "HorizontalLine", `One 0x02500; + "Hscr", `One 0x0210B; + "hscr", `One 0x1D4BD; + "hslash", `One 0x0210F; + "Hstrok", `One 0x00126; + "hstrok", `One 0x00127; + "HumpDownHump", `One 0x0224E; + "HumpEqual", `One 0x0224F; + "hybull", `One 0x02043; + "hyphen", `One 0x02010; + "Iacute", `One 0x000CD; + "Iacut", `One 0x000CD; + "iacute", `One 0x000ED; + "iacut", `One 0x000ED; + "ic", `One 0x02063; + "Icirc", `One 0x000CE; + "Icir", `One 0x000CE; + "icirc", `One 0x000EE; + "icir", `One 0x000EE; + "Icy", `One 0x00418; + "icy", `One 0x00438; + "Idot", `One 0x00130; + "IEcy", `One 0x00415; + "iecy", `One 0x00435; + "iexcl", `One 0x000A1; + "iexc", `One 0x000A1; + "iff", `One 0x021D4; + "Ifr", `One 0x02111; + "ifr", `One 0x1D526; + "Igrave", `One 0x000CC; + "Igrav", `One 0x000CC; + "igrave", `One 0x000EC; + "igrav", `One 0x000EC; + "ii", `One 0x02148; + "iiiint", `One 0x02A0C; + "iiint", `One 0x0222D; + "iinfin", `One 0x029DC; + "iiota", `One 0x02129; + "IJlig", `One 0x00132; + "ijlig", `One 0x00133; + "Im", `One 0x02111; + "Imacr", `One 0x0012A; + "imacr", `One 0x0012B; + "image", `One 0x02111; + "ImaginaryI", `One 0x02148; + "imagline", `One 0x02110; + "imagpart", `One 0x02111; + "imath", `One 0x00131; + "imof", `One 0x022B7; + "imped", `One 0x001B5; + "Implies", `One 0x021D2; + "in", `One 0x02208; + "incare", `One 0x02105; + "infin", `One 0x0221E; + "infintie", `One 0x029DD; + "inodot", `One 0x00131; + "Int", `One 0x0222C; + "int", `One 0x0222B; + "intcal", `One 0x022BA; + "integers", `One 0x02124; + "Integral", `One 0x0222B; + "intercal", `One 0x022BA; + "Intersection", `One 0x022C2; + "intlarhk", `One 0x02A17; + "intprod", `One 0x02A3C; + "InvisibleComma", `One 0x02063; + "InvisibleTimes", `One 0x02062; + "IOcy", `One 0x00401; + "iocy", `One 0x00451; + "Iogon", `One 0x0012E; + "iogon", `One 0x0012F; + "Iopf", `One 0x1D540; + "iopf", `One 0x1D55A; + "Iota", `One 0x00399; + "iota", `One 0x003B9; + "iprod", `One 0x02A3C; + "iquest", `One 0x000BF; + "iques", `One 0x000BF; + "Iscr", `One 0x02110; + "iscr", `One 0x1D4BE; + "isin", `One 0x02208; + "isindot", `One 0x022F5; + "isinE", `One 0x022F9; + "isins", `One 0x022F4; + "isinsv", `One 0x022F3; + "isinv", `One 0x02208; + "it", `One 0x02062; + "Itilde", `One 0x00128; + "itilde", `One 0x00129; + "Iukcy", `One 0x00406; + "iukcy", `One 0x00456; + "Iuml", `One 0x000CF; + "Ium", `One 0x000CF; + "iuml", `One 0x000EF; + "ium", `One 0x000EF; + "Jcirc", `One 0x00134; + "jcirc", `One 0x00135; + "Jcy", `One 0x00419; + "jcy", `One 0x00439; + "Jfr", `One 0x1D50D; + "jfr", `One 0x1D527; + "jmath", `One 0x00237; + "Jopf", `One 0x1D541; + "jopf", `One 0x1D55B; + "Jscr", `One 0x1D4A5; + "jscr", `One 0x1D4BF; + "Jsercy", `One 0x00408; + "jsercy", `One 0x00458; + "Jukcy", `One 0x00404; + "jukcy", `One 0x00454; + "Kappa", `One 0x0039A; + "kappa", `One 0x003BA; + "kappav", `One 0x003F0; + "Kcedil", `One 0x00136; + "kcedil", `One 0x00137; + "Kcy", `One 0x0041A; + "kcy", `One 0x0043A; + "Kfr", `One 0x1D50E; + "kfr", `One 0x1D528; + "kgreen", `One 0x00138; + "KHcy", `One 0x00425; + "khcy", `One 0x00445; + "KJcy", `One 0x0040C; + "kjcy", `One 0x0045C; + "Kopf", `One 0x1D542; + "kopf", `One 0x1D55C; + "Kscr", `One 0x1D4A6; + "kscr", `One 0x1D4C0; + "lAarr", `One 0x021DA; + "Lacute", `One 0x00139; + "lacute", `One 0x0013A; + "laemptyv", `One 0x029B4; + "lagran", `One 0x02112; + "Lambda", `One 0x0039B; + "lambda", `One 0x003BB; + "Lang", `One 0x027EA; + "lang", `One 0x027E8; + "langd", `One 0x02991; + "langle", `One 0x027E8; + "lap", `One 0x02A85; + "Laplacetrf", `One 0x02112; + "laquo", `One 0x000AB; + "laqu", `One 0x000AB; + "Larr", `One 0x0219E; + "lArr", `One 0x021D0; + "larr", `One 0x02190; + "larrb", `One 0x021E4; + "larrbfs", `One 0x0291F; + "larrfs", `One 0x0291D; + "larrhk", `One 0x021A9; + "larrlp", `One 0x021AB; + "larrpl", `One 0x02939; + "larrsim", `One 0x02973; + "larrtl", `One 0x021A2; + "lat", `One 0x02AAB; + "lAtail", `One 0x0291B; + "latail", `One 0x02919; + "late", `One 0x02AAD; + "lates", `Two (0x02AAD, 0x0FE00); + "lBarr", `One 0x0290E; + "lbarr", `One 0x0290C; + "lbbrk", `One 0x02772; + "lbrace", `One 0x0007B; + "lbrack", `One 0x0005B; + "lbrke", `One 0x0298B; + "lbrksld", `One 0x0298F; + "lbrkslu", `One 0x0298D; + "Lcaron", `One 0x0013D; + "lcaron", `One 0x0013E; + "Lcedil", `One 0x0013B; + "lcedil", `One 0x0013C; + "lceil", `One 0x02308; + "lcub", `One 0x0007B; + "Lcy", `One 0x0041B; + "lcy", `One 0x0043B; + "ldca", `One 0x02936; + "ldquo", `One 0x0201C; + "ldquor", `One 0x0201E; + "ldrdhar", `One 0x02967; + "ldrushar", `One 0x0294B; + "ldsh", `One 0x021B2; + "lE", `One 0x02266; + "le", `One 0x02264; + "LeftAngleBracket", `One 0x027E8; + "LeftArrow", `One 0x02190; + "Leftarrow", `One 0x021D0; + "leftarrow", `One 0x02190; + "LeftArrowBar", `One 0x021E4; + "LeftArrowRightArrow", `One 0x021C6; + "leftarrowtail", `One 0x021A2; + "LeftCeiling", `One 0x02308; + "LeftDoubleBracket", `One 0x027E6; + "LeftDownTeeVector", `One 0x02961; + "LeftDownVector", `One 0x021C3; + "LeftDownVectorBar", `One 0x02959; + "LeftFloor", `One 0x0230A; + "leftharpoondown", `One 0x021BD; + "leftharpoonup", `One 0x021BC; + "leftleftarrows", `One 0x021C7; + "LeftRightArrow", `One 0x02194; + "Leftrightarrow", `One 0x021D4; + "leftrightarrow", `One 0x02194; + "leftrightarrows", `One 0x021C6; + "leftrightharpoons", `One 0x021CB; + "leftrightsquigarrow", `One 0x021AD; + "LeftRightVector", `One 0x0294E; + "LeftTee", `One 0x022A3; + "LeftTeeArrow", `One 0x021A4; + "LeftTeeVector", `One 0x0295A; + "leftthreetimes", `One 0x022CB; + "LeftTriangle", `One 0x022B2; + "LeftTriangleBar", `One 0x029CF; + "LeftTriangleEqual", `One 0x022B4; + "LeftUpDownVector", `One 0x02951; + "LeftUpTeeVector", `One 0x02960; + "LeftUpVector", `One 0x021BF; + "LeftUpVectorBar", `One 0x02958; + "LeftVector", `One 0x021BC; + "LeftVectorBar", `One 0x02952; + "lEg", `One 0x02A8B; + "leg", `One 0x022DA; + "leq", `One 0x02264; + "leqq", `One 0x02266; + "leqslant", `One 0x02A7D; + "les", `One 0x02A7D; + "lescc", `One 0x02AA8; + "lesdot", `One 0x02A7F; + "lesdoto", `One 0x02A81; + "lesdotor", `One 0x02A83; + "lesg", `Two (0x022DA, 0x0FE00); + "lesges", `One 0x02A93; + "lessapprox", `One 0x02A85; + "lessdot", `One 0x022D6; + "lesseqgtr", `One 0x022DA; + "lesseqqgtr", `One 0x02A8B; + "LessEqualGreater", `One 0x022DA; + "LessFullEqual", `One 0x02266; + "LessGreater", `One 0x02276; + "lessgtr", `One 0x02276; + "LessLess", `One 0x02AA1; + "lesssim", `One 0x02272; + "LessSlantEqual", `One 0x02A7D; + "LessTilde", `One 0x02272; + "lfisht", `One 0x0297C; + "lfloor", `One 0x0230A; + "Lfr", `One 0x1D50F; + "lfr", `One 0x1D529; + "lg", `One 0x02276; + "lgE", `One 0x02A91; + "lHar", `One 0x02962; + "lhard", `One 0x021BD; + "lharu", `One 0x021BC; + "lharul", `One 0x0296A; + "lhblk", `One 0x02584; + "LJcy", `One 0x00409; + "ljcy", `One 0x00459; + "Ll", `One 0x022D8; + "ll", `One 0x0226A; + "llarr", `One 0x021C7; + "llcorner", `One 0x0231E; + "Lleftarrow", `One 0x021DA; + "llhard", `One 0x0296B; + "lltri", `One 0x025FA; + "Lmidot", `One 0x0013F; + "lmidot", `One 0x00140; + "lmoust", `One 0x023B0; + "lmoustache", `One 0x023B0; + "lnap", `One 0x02A89; + "lnapprox", `One 0x02A89; + "lnE", `One 0x02268; + "lne", `One 0x02A87; + "lneq", `One 0x02A87; + "lneqq", `One 0x02268; + "lnsim", `One 0x022E6; + "loang", `One 0x027EC; + "loarr", `One 0x021FD; + "lobrk", `One 0x027E6; + "LongLeftArrow", `One 0x027F5; + "Longleftarrow", `One 0x027F8; + "longleftarrow", `One 0x027F5; + "LongLeftRightArrow", `One 0x027F7; + "Longleftrightarrow", `One 0x027FA; + "longleftrightarrow", `One 0x027F7; + "longmapsto", `One 0x027FC; + "LongRightArrow", `One 0x027F6; + "Longrightarrow", `One 0x027F9; + "longrightarrow", `One 0x027F6; + "looparrowleft", `One 0x021AB; + "looparrowright", `One 0x021AC; + "lopar", `One 0x02985; + "Lopf", `One 0x1D543; + "lopf", `One 0x1D55D; + "loplus", `One 0x02A2D; + "lotimes", `One 0x02A34; + "lowast", `One 0x02217; + "lowbar", `One 0x0005F; + "LowerLeftArrow", `One 0x02199; + "LowerRightArrow", `One 0x02198; + "loz", `One 0x025CA; + "lozenge", `One 0x025CA; + "lozf", `One 0x029EB; + "lpar", `One 0x00028; + "lparlt", `One 0x02993; + "lrarr", `One 0x021C6; + "lrcorner", `One 0x0231F; + "lrhar", `One 0x021CB; + "lrhard", `One 0x0296D; + "lrm", `One 0x0200E; + "lrtri", `One 0x022BF; + "lsaquo", `One 0x02039; + "Lscr", `One 0x02112; + "lscr", `One 0x1D4C1; + "Lsh", `One 0x021B0; + "lsh", `One 0x021B0; + "lsim", `One 0x02272; + "lsime", `One 0x02A8D; + "lsimg", `One 0x02A8F; + "lsqb", `One 0x0005B; + "lsquo", `One 0x02018; + "lsquor", `One 0x0201A; + "Lstrok", `One 0x00141; + "lstrok", `One 0x00142; + "LT", `One 0x0003C; + "L", `One 0x0003C; + "Lt", `One 0x0226A; + "lt", `One 0x0003C; + "l", `One 0x0003C; + "ltcc", `One 0x02AA6; + "ltcir", `One 0x02A79; + "ltdot", `One 0x022D6; + "lthree", `One 0x022CB; + "ltimes", `One 0x022C9; + "ltlarr", `One 0x02976; + "ltquest", `One 0x02A7B; + "ltri", `One 0x025C3; + "ltrie", `One 0x022B4; + "ltrif", `One 0x025C2; + "ltrPar", `One 0x02996; + "lurdshar", `One 0x0294A; + "luruhar", `One 0x02966; + "lvertneqq", `Two (0x02268, 0x0FE00); + "lvnE", `Two (0x02268, 0x0FE00); + "macr", `One 0x000AF; + "mac", `One 0x000AF; + "male", `One 0x02642; + "malt", `One 0x02720; + "maltese", `One 0x02720; + "Map", `One 0x02905; + "map", `One 0x021A6; + "mapsto", `One 0x021A6; + "mapstodown", `One 0x021A7; + "mapstoleft", `One 0x021A4; + "mapstoup", `One 0x021A5; + "marker", `One 0x025AE; + "mcomma", `One 0x02A29; + "Mcy", `One 0x0041C; + "mcy", `One 0x0043C; + "mdash", `One 0x02014; + "mDDot", `One 0x0223A; + "measuredangle", `One 0x02221; + "MediumSpace", `One 0x0205F; + "Mellintrf", `One 0x02133; + "Mfr", `One 0x1D510; + "mfr", `One 0x1D52A; + "mho", `One 0x02127; + "micro", `One 0x000B5; + "micr", `One 0x000B5; + "mid", `One 0x02223; + "midast", `One 0x0002A; + "midcir", `One 0x02AF0; + "middot", `One 0x000B7; + "middo", `One 0x000B7; + "minus", `One 0x02212; + "minusb", `One 0x0229F; + "minusd", `One 0x02238; + "minusdu", `One 0x02A2A; + "MinusPlus", `One 0x02213; + "mlcp", `One 0x02ADB; + "mldr", `One 0x02026; + "mnplus", `One 0x02213; + "models", `One 0x022A7; + "Mopf", `One 0x1D544; + "mopf", `One 0x1D55E; + "mp", `One 0x02213; + "Mscr", `One 0x02133; + "mscr", `One 0x1D4C2; + "mstpos", `One 0x0223E; + "Mu", `One 0x0039C; + "mu", `One 0x003BC; + "multimap", `One 0x022B8; + "mumap", `One 0x022B8; + "nabla", `One 0x02207; + "Nacute", `One 0x00143; + "nacute", `One 0x00144; + "nang", `Two (0x02220, 0x020D2); + "nap", `One 0x02249; + "napE", `Two (0x02A70, 0x00338); + "napid", `Two (0x0224B, 0x00338); + "napos", `One 0x00149; + "napprox", `One 0x02249; + "natur", `One 0x0266E; + "natural", `One 0x0266E; + "naturals", `One 0x02115; + "nbsp", `One 0x000A0; + "nbs", `One 0x000A0; + "nbump", `Two (0x0224E, 0x00338); + "nbumpe", `Two (0x0224F, 0x00338); + "ncap", `One 0x02A43; + "Ncaron", `One 0x00147; + "ncaron", `One 0x00148; + "Ncedil", `One 0x00145; + "ncedil", `One 0x00146; + "ncong", `One 0x02247; + "ncongdot", `Two (0x02A6D, 0x00338); + "ncup", `One 0x02A42; + "Ncy", `One 0x0041D; + "ncy", `One 0x0043D; + "ndash", `One 0x02013; + "ne", `One 0x02260; + "nearhk", `One 0x02924; + "neArr", `One 0x021D7; + "nearr", `One 0x02197; + "nearrow", `One 0x02197; + "nedot", `Two (0x02250, 0x00338); + "NegativeMediumSpace", `One 0x0200B; + "NegativeThickSpace", `One 0x0200B; + "NegativeThinSpace", `One 0x0200B; + "NegativeVeryThinSpace", `One 0x0200B; + "nequiv", `One 0x02262; + "nesear", `One 0x02928; + "nesim", `Two (0x02242, 0x00338); + "NestedGreaterGreater", `One 0x0226B; + "NestedLessLess", `One 0x0226A; + "NewLine", `One 0x0000A; + "nexist", `One 0x02204; + "nexists", `One 0x02204; + "Nfr", `One 0x1D511; + "nfr", `One 0x1D52B; + "ngE", `Two (0x02267, 0x00338); + "nge", `One 0x02271; + "ngeq", `One 0x02271; + "ngeqq", `Two (0x02267, 0x00338); + "ngeqslant", `Two (0x02A7E, 0x00338); + "nges", `Two (0x02A7E, 0x00338); + "nGg", `Two (0x022D9, 0x00338); + "ngsim", `One 0x02275; + "nGt", `Two (0x0226B, 0x020D2); + "ngt", `One 0x0226F; + "ngtr", `One 0x0226F; + "nGtv", `Two (0x0226B, 0x00338); + "nhArr", `One 0x021CE; + "nharr", `One 0x021AE; + "nhpar", `One 0x02AF2; + "ni", `One 0x0220B; + "nis", `One 0x022FC; + "nisd", `One 0x022FA; + "niv", `One 0x0220B; + "NJcy", `One 0x0040A; + "njcy", `One 0x0045A; + "nlArr", `One 0x021CD; + "nlarr", `One 0x0219A; + "nldr", `One 0x02025; + "nlE", `Two (0x02266, 0x00338); + "nle", `One 0x02270; + "nLeftarrow", `One 0x021CD; + "nleftarrow", `One 0x0219A; + "nLeftrightarrow", `One 0x021CE; + "nleftrightarrow", `One 0x021AE; + "nleq", `One 0x02270; + "nleqq", `Two (0x02266, 0x00338); + "nleqslant", `Two (0x02A7D, 0x00338); + "nles", `Two (0x02A7D, 0x00338); + "nless", `One 0x0226E; + "nLl", `Two (0x022D8, 0x00338); + "nlsim", `One 0x02274; + "nLt", `Two (0x0226A, 0x020D2); + "nlt", `One 0x0226E; + "nltri", `One 0x022EA; + "nltrie", `One 0x022EC; + "nLtv", `Two (0x0226A, 0x00338); + "nmid", `One 0x02224; + "NoBreak", `One 0x02060; + "NonBreakingSpace", `One 0x000A0; + "Nopf", `One 0x02115; + "nopf", `One 0x1D55F; + "Not", `One 0x02AEC; + "not", `One 0x000AC; + "no", `One 0x000AC; + "NotCongruent", `One 0x02262; + "NotCupCap", `One 0x0226D; + "NotDoubleVerticalBar", `One 0x02226; + "NotElement", `One 0x02209; + "NotEqual", `One 0x02260; + "NotEqualTilde", `Two (0x02242, 0x00338); + "NotExists", `One 0x02204; + "NotGreater", `One 0x0226F; + "NotGreaterEqual", `One 0x02271; + "NotGreaterFullEqual", `Two (0x02267, 0x00338); + "NotGreaterGreater", `Two (0x0226B, 0x00338); + "NotGreaterLess", `One 0x02279; + "NotGreaterSlantEqual", `Two (0x02A7E, 0x00338); + "NotGreaterTilde", `One 0x02275; + "NotHumpDownHump", `Two (0x0224E, 0x00338); + "NotHumpEqual", `Two (0x0224F, 0x00338); + "notin", `One 0x02209; + "notindot", `Two (0x022F5, 0x00338); + "notinE", `Two (0x022F9, 0x00338); + "notinva", `One 0x02209; + "notinvb", `One 0x022F7; + "notinvc", `One 0x022F6; + "NotLeftTriangle", `One 0x022EA; + "NotLeftTriangleBar", `Two (0x029CF, 0x00338); + "NotLeftTriangleEqual", `One 0x022EC; + "NotLess", `One 0x0226E; + "NotLessEqual", `One 0x02270; + "NotLessGreater", `One 0x02278; + "NotLessLess", `Two (0x0226A, 0x00338); + "NotLessSlantEqual", `Two (0x02A7D, 0x00338); + "NotLessTilde", `One 0x02274; + "NotNestedGreaterGreater", `Two (0x02AA2, 0x00338); + "NotNestedLessLess", `Two (0x02AA1, 0x00338); + "notni", `One 0x0220C; + "notniva", `One 0x0220C; + "notnivb", `One 0x022FE; + "notnivc", `One 0x022FD; + "NotPrecedes", `One 0x02280; + "NotPrecedesEqual", `Two (0x02AAF, 0x00338); + "NotPrecedesSlantEqual", `One 0x022E0; + "NotReverseElement", `One 0x0220C; + "NotRightTriangle", `One 0x022EB; + "NotRightTriangleBar", `Two (0x029D0, 0x00338); + "NotRightTriangleEqual", `One 0x022ED; + "NotSquareSubset", `Two (0x0228F, 0x00338); + "NotSquareSubsetEqual", `One 0x022E2; + "NotSquareSuperset", `Two (0x02290, 0x00338); + "NotSquareSupersetEqual", `One 0x022E3; + "NotSubset", `Two (0x02282, 0x020D2); + "NotSubsetEqual", `One 0x02288; + "NotSucceeds", `One 0x02281; + "NotSucceedsEqual", `Two (0x02AB0, 0x00338); + "NotSucceedsSlantEqual", `One 0x022E1; + "NotSucceedsTilde", `Two (0x0227F, 0x00338); + "NotSuperset", `Two (0x02283, 0x020D2); + "NotSupersetEqual", `One 0x02289; + "NotTilde", `One 0x02241; + "NotTildeEqual", `One 0x02244; + "NotTildeFullEqual", `One 0x02247; + "NotTildeTilde", `One 0x02249; + "NotVerticalBar", `One 0x02224; + "npar", `One 0x02226; + "nparallel", `One 0x02226; + "nparsl", `Two (0x02AFD, 0x020E5); + "npart", `Two (0x02202, 0x00338); + "npolint", `One 0x02A14; + "npr", `One 0x02280; + "nprcue", `One 0x022E0; + "npre", `Two (0x02AAF, 0x00338); + "nprec", `One 0x02280; + "npreceq", `Two (0x02AAF, 0x00338); + "nrArr", `One 0x021CF; + "nrarr", `One 0x0219B; + "nrarrc", `Two (0x02933, 0x00338); + "nrarrw", `Two (0x0219D, 0x00338); + "nRightarrow", `One 0x021CF; + "nrightarrow", `One 0x0219B; + "nrtri", `One 0x022EB; + "nrtrie", `One 0x022ED; + "nsc", `One 0x02281; + "nsccue", `One 0x022E1; + "nsce", `Two (0x02AB0, 0x00338); + "Nscr", `One 0x1D4A9; + "nscr", `One 0x1D4C3; + "nshortmid", `One 0x02224; + "nshortparallel", `One 0x02226; + "nsim", `One 0x02241; + "nsime", `One 0x02244; + "nsimeq", `One 0x02244; + "nsmid", `One 0x02224; + "nspar", `One 0x02226; + "nsqsube", `One 0x022E2; + "nsqsupe", `One 0x022E3; + "nsub", `One 0x02284; + "nsubE", `Two (0x02AC5, 0x00338); + "nsube", `One 0x02288; + "nsubset", `Two (0x02282, 0x020D2); + "nsubseteq", `One 0x02288; + "nsubseteqq", `Two (0x02AC5, 0x00338); + "nsucc", `One 0x02281; + "nsucceq", `Two (0x02AB0, 0x00338); + "nsup", `One 0x02285; + "nsupE", `Two (0x02AC6, 0x00338); + "nsupe", `One 0x02289; + "nsupset", `Two (0x02283, 0x020D2); + "nsupseteq", `One 0x02289; + "nsupseteqq", `Two (0x02AC6, 0x00338); + "ntgl", `One 0x02279; + "Ntilde", `One 0x000D1; + "Ntild", `One 0x000D1; + "ntilde", `One 0x000F1; + "ntild", `One 0x000F1; + "ntlg", `One 0x02278; + "ntriangleleft", `One 0x022EA; + "ntrianglelefteq", `One 0x022EC; + "ntriangleright", `One 0x022EB; + "ntrianglerighteq", `One 0x022ED; + "Nu", `One 0x0039D; + "nu", `One 0x003BD; + "num", `One 0x00023; + "numero", `One 0x02116; + "numsp", `One 0x02007; + "nvap", `Two (0x0224D, 0x020D2); + "nVDash", `One 0x022AF; + "nVdash", `One 0x022AE; + "nvDash", `One 0x022AD; + "nvdash", `One 0x022AC; + "nvge", `Two (0x02265, 0x020D2); + "nvgt", `Two (0x0003E, 0x020D2); + "nvHarr", `One 0x02904; + "nvinfin", `One 0x029DE; + "nvlArr", `One 0x02902; + "nvle", `Two (0x02264, 0x020D2); + "nvlt", `Two (0x0003C, 0x020D2); + "nvltrie", `Two (0x022B4, 0x020D2); + "nvrArr", `One 0x02903; + "nvrtrie", `Two (0x022B5, 0x020D2); + "nvsim", `Two (0x0223C, 0x020D2); + "nwarhk", `One 0x02923; + "nwArr", `One 0x021D6; + "nwarr", `One 0x02196; + "nwarrow", `One 0x02196; + "nwnear", `One 0x02927; + "Oacute", `One 0x000D3; + "Oacut", `One 0x000D3; + "oacute", `One 0x000F3; + "oacut", `One 0x000F3; + "oast", `One 0x0229B; + "ocir", `One 0x0229A; + "Ocirc", `One 0x000D4; + "Ocir", `One 0x000D4; + "ocirc", `One 0x000F4; + "ocir", `One 0x000F4; + "Ocy", `One 0x0041E; + "ocy", `One 0x0043E; + "odash", `One 0x0229D; + "Odblac", `One 0x00150; + "odblac", `One 0x00151; + "odiv", `One 0x02A38; + "odot", `One 0x02299; + "odsold", `One 0x029BC; + "OElig", `One 0x00152; + "oelig", `One 0x00153; + "ofcir", `One 0x029BF; + "Ofr", `One 0x1D512; + "ofr", `One 0x1D52C; + "ogon", `One 0x002DB; + "Ograve", `One 0x000D2; + "Ograv", `One 0x000D2; + "ograve", `One 0x000F2; + "ograv", `One 0x000F2; + "ogt", `One 0x029C1; + "ohbar", `One 0x029B5; + "ohm", `One 0x003A9; + "oint", `One 0x0222E; + "olarr", `One 0x021BA; + "olcir", `One 0x029BE; + "olcross", `One 0x029BB; + "oline", `One 0x0203E; + "olt", `One 0x029C0; + "Omacr", `One 0x0014C; + "omacr", `One 0x0014D; + "Omega", `One 0x003A9; + "omega", `One 0x003C9; + "Omicron", `One 0x0039F; + "omicron", `One 0x003BF; + "omid", `One 0x029B6; + "ominus", `One 0x02296; + "Oopf", `One 0x1D546; + "oopf", `One 0x1D560; + "opar", `One 0x029B7; + "OpenCurlyDoubleQuote", `One 0x0201C; + "OpenCurlyQuote", `One 0x02018; + "operp", `One 0x029B9; + "oplus", `One 0x02295; + "Or", `One 0x02A54; + "or", `One 0x02228; + "orarr", `One 0x021BB; + "ord", `One 0x02A5D; + "order", `One 0x02134; + "orderof", `One 0x02134; + "ordf", `One 0x000AA; + "ord", `One 0x000AA; + "ordm", `One 0x000BA; + "ord", `One 0x000BA; + "origof", `One 0x022B6; + "oror", `One 0x02A56; + "orslope", `One 0x02A57; + "orv", `One 0x02A5B; + "oS", `One 0x024C8; + "Oscr", `One 0x1D4AA; + "oscr", `One 0x02134; + "Oslash", `One 0x000D8; + "Oslas", `One 0x000D8; + "oslash", `One 0x000F8; + "oslas", `One 0x000F8; + "osol", `One 0x02298; + "Otilde", `One 0x000D5; + "Otild", `One 0x000D5; + "otilde", `One 0x000F5; + "otild", `One 0x000F5; + "Otimes", `One 0x02A37; + "otimes", `One 0x02297; + "otimesas", `One 0x02A36; + "Ouml", `One 0x000D6; + "Oum", `One 0x000D6; + "ouml", `One 0x000F6; + "oum", `One 0x000F6; + "ovbar", `One 0x0233D; + "OverBar", `One 0x0203E; + "OverBrace", `One 0x023DE; + "OverBracket", `One 0x023B4; + "OverParenthesis", `One 0x023DC; + "par", `One 0x02225; + "para", `One 0x000B6; + "par", `One 0x000B6; + "parallel", `One 0x02225; + "parsim", `One 0x02AF3; + "parsl", `One 0x02AFD; + "part", `One 0x02202; + "PartialD", `One 0x02202; + "Pcy", `One 0x0041F; + "pcy", `One 0x0043F; + "percnt", `One 0x00025; + "period", `One 0x0002E; + "permil", `One 0x02030; + "perp", `One 0x022A5; + "pertenk", `One 0x02031; + "Pfr", `One 0x1D513; + "pfr", `One 0x1D52D; + "Phi", `One 0x003A6; + "phi", `One 0x003C6; + "phiv", `One 0x003D5; + "phmmat", `One 0x02133; + "phone", `One 0x0260E; + "Pi", `One 0x003A0; + "pi", `One 0x003C0; + "pitchfork", `One 0x022D4; + "piv", `One 0x003D6; + "planck", `One 0x0210F; + "planckh", `One 0x0210E; + "plankv", `One 0x0210F; + "plus", `One 0x0002B; + "plusacir", `One 0x02A23; + "plusb", `One 0x0229E; + "pluscir", `One 0x02A22; + "plusdo", `One 0x02214; + "plusdu", `One 0x02A25; + "pluse", `One 0x02A72; + "PlusMinus", `One 0x000B1; + "plusmn", `One 0x000B1; + "plusm", `One 0x000B1; + "plussim", `One 0x02A26; + "plustwo", `One 0x02A27; + "pm", `One 0x000B1; + "Poincareplane", `One 0x0210C; + "pointint", `One 0x02A15; + "Popf", `One 0x02119; + "popf", `One 0x1D561; + "pound", `One 0x000A3; + "poun", `One 0x000A3; + "Pr", `One 0x02ABB; + "pr", `One 0x0227A; + "prap", `One 0x02AB7; + "prcue", `One 0x0227C; + "prE", `One 0x02AB3; + "pre", `One 0x02AAF; + "prec", `One 0x0227A; + "precapprox", `One 0x02AB7; + "preccurlyeq", `One 0x0227C; + "Precedes", `One 0x0227A; + "PrecedesEqual", `One 0x02AAF; + "PrecedesSlantEqual", `One 0x0227C; + "PrecedesTilde", `One 0x0227E; + "preceq", `One 0x02AAF; + "precnapprox", `One 0x02AB9; + "precneqq", `One 0x02AB5; + "precnsim", `One 0x022E8; + "precsim", `One 0x0227E; + "Prime", `One 0x02033; + "prime", `One 0x02032; + "primes", `One 0x02119; + "prnap", `One 0x02AB9; + "prnE", `One 0x02AB5; + "prnsim", `One 0x022E8; + "prod", `One 0x0220F; + "Product", `One 0x0220F; + "profalar", `One 0x0232E; + "profline", `One 0x02312; + "profsurf", `One 0x02313; + "prop", `One 0x0221D; + "Proportion", `One 0x02237; + "Proportional", `One 0x0221D; + "propto", `One 0x0221D; + "prsim", `One 0x0227E; + "prurel", `One 0x022B0; + "Pscr", `One 0x1D4AB; + "pscr", `One 0x1D4C5; + "Psi", `One 0x003A8; + "psi", `One 0x003C8; + "puncsp", `One 0x02008; + "Qfr", `One 0x1D514; + "qfr", `One 0x1D52E; + "qint", `One 0x02A0C; + "Qopf", `One 0x0211A; + "qopf", `One 0x1D562; + "qprime", `One 0x02057; + "Qscr", `One 0x1D4AC; + "qscr", `One 0x1D4C6; + "quaternions", `One 0x0210D; + "quatint", `One 0x02A16; + "quest", `One 0x0003F; + "questeq", `One 0x0225F; + "QUOT", `One 0x00022; + "QUO", `One 0x00022; + "quot", `One 0x00022; + "quo", `One 0x00022; + "rAarr", `One 0x021DB; + "race", `Two (0x0223D, 0x00331); + "Racute", `One 0x00154; + "racute", `One 0x00155; + "radic", `One 0x0221A; + "raemptyv", `One 0x029B3; + "Rang", `One 0x027EB; + "rang", `One 0x027E9; + "rangd", `One 0x02992; + "range", `One 0x029A5; + "rangle", `One 0x027E9; + "raquo", `One 0x000BB; + "raqu", `One 0x000BB; + "Rarr", `One 0x021A0; + "rArr", `One 0x021D2; + "rarr", `One 0x02192; + "rarrap", `One 0x02975; + "rarrb", `One 0x021E5; + "rarrbfs", `One 0x02920; + "rarrc", `One 0x02933; + "rarrfs", `One 0x0291E; + "rarrhk", `One 0x021AA; + "rarrlp", `One 0x021AC; + "rarrpl", `One 0x02945; + "rarrsim", `One 0x02974; + "Rarrtl", `One 0x02916; + "rarrtl", `One 0x021A3; + "rarrw", `One 0x0219D; + "rAtail", `One 0x0291C; + "ratail", `One 0x0291A; + "ratio", `One 0x02236; + "rationals", `One 0x0211A; + "RBarr", `One 0x02910; + "rBarr", `One 0x0290F; + "rbarr", `One 0x0290D; + "rbbrk", `One 0x02773; + "rbrace", `One 0x0007D; + "rbrack", `One 0x0005D; + "rbrke", `One 0x0298C; + "rbrksld", `One 0x0298E; + "rbrkslu", `One 0x02990; + "Rcaron", `One 0x00158; + "rcaron", `One 0x00159; + "Rcedil", `One 0x00156; + "rcedil", `One 0x00157; + "rceil", `One 0x02309; + "rcub", `One 0x0007D; + "Rcy", `One 0x00420; + "rcy", `One 0x00440; + "rdca", `One 0x02937; + "rdldhar", `One 0x02969; + "rdquo", `One 0x0201D; + "rdquor", `One 0x0201D; + "rdsh", `One 0x021B3; + "Re", `One 0x0211C; + "real", `One 0x0211C; + "realine", `One 0x0211B; + "realpart", `One 0x0211C; + "reals", `One 0x0211D; + "rect", `One 0x025AD; + "REG", `One 0x000AE; + "RE", `One 0x000AE; + "reg", `One 0x000AE; + "re", `One 0x000AE; + "ReverseElement", `One 0x0220B; + "ReverseEquilibrium", `One 0x021CB; + "ReverseUpEquilibrium", `One 0x0296F; + "rfisht", `One 0x0297D; + "rfloor", `One 0x0230B; + "Rfr", `One 0x0211C; + "rfr", `One 0x1D52F; + "rHar", `One 0x02964; + "rhard", `One 0x021C1; + "rharu", `One 0x021C0; + "rharul", `One 0x0296C; + "Rho", `One 0x003A1; + "rho", `One 0x003C1; + "rhov", `One 0x003F1; + "RightAngleBracket", `One 0x027E9; + "RightArrow", `One 0x02192; + "Rightarrow", `One 0x021D2; + "rightarrow", `One 0x02192; + "RightArrowBar", `One 0x021E5; + "RightArrowLeftArrow", `One 0x021C4; + "rightarrowtail", `One 0x021A3; + "RightCeiling", `One 0x02309; + "RightDoubleBracket", `One 0x027E7; + "RightDownTeeVector", `One 0x0295D; + "RightDownVector", `One 0x021C2; + "RightDownVectorBar", `One 0x02955; + "RightFloor", `One 0x0230B; + "rightharpoondown", `One 0x021C1; + "rightharpoonup", `One 0x021C0; + "rightleftarrows", `One 0x021C4; + "rightleftharpoons", `One 0x021CC; + "rightrightarrows", `One 0x021C9; + "rightsquigarrow", `One 0x0219D; + "RightTee", `One 0x022A2; + "RightTeeArrow", `One 0x021A6; + "RightTeeVector", `One 0x0295B; + "rightthreetimes", `One 0x022CC; + "RightTriangle", `One 0x022B3; + "RightTriangleBar", `One 0x029D0; + "RightTriangleEqual", `One 0x022B5; + "RightUpDownVector", `One 0x0294F; + "RightUpTeeVector", `One 0x0295C; + "RightUpVector", `One 0x021BE; + "RightUpVectorBar", `One 0x02954; + "RightVector", `One 0x021C0; + "RightVectorBar", `One 0x02953; + "ring", `One 0x002DA; + "risingdotseq", `One 0x02253; + "rlarr", `One 0x021C4; + "rlhar", `One 0x021CC; + "rlm", `One 0x0200F; + "rmoust", `One 0x023B1; + "rmoustache", `One 0x023B1; + "rnmid", `One 0x02AEE; + "roang", `One 0x027ED; + "roarr", `One 0x021FE; + "robrk", `One 0x027E7; + "ropar", `One 0x02986; + "Ropf", `One 0x0211D; + "ropf", `One 0x1D563; + "roplus", `One 0x02A2E; + "rotimes", `One 0x02A35; + "RoundImplies", `One 0x02970; + "rpar", `One 0x00029; + "rpargt", `One 0x02994; + "rppolint", `One 0x02A12; + "rrarr", `One 0x021C9; + "Rrightarrow", `One 0x021DB; + "rsaquo", `One 0x0203A; + "Rscr", `One 0x0211B; + "rscr", `One 0x1D4C7; + "Rsh", `One 0x021B1; + "rsh", `One 0x021B1; + "rsqb", `One 0x0005D; + "rsquo", `One 0x02019; + "rsquor", `One 0x02019; + "rthree", `One 0x022CC; + "rtimes", `One 0x022CA; + "rtri", `One 0x025B9; + "rtrie", `One 0x022B5; + "rtrif", `One 0x025B8; + "rtriltri", `One 0x029CE; + "RuleDelayed", `One 0x029F4; + "ruluhar", `One 0x02968; + "rx", `One 0x0211E; + "Sacute", `One 0x0015A; + "sacute", `One 0x0015B; + "sbquo", `One 0x0201A; + "Sc", `One 0x02ABC; + "sc", `One 0x0227B; + "scap", `One 0x02AB8; + "Scaron", `One 0x00160; + "scaron", `One 0x00161; + "sccue", `One 0x0227D; + "scE", `One 0x02AB4; + "sce", `One 0x02AB0; + "Scedil", `One 0x0015E; + "scedil", `One 0x0015F; + "Scirc", `One 0x0015C; + "scirc", `One 0x0015D; + "scnap", `One 0x02ABA; + "scnE", `One 0x02AB6; + "scnsim", `One 0x022E9; + "scpolint", `One 0x02A13; + "scsim", `One 0x0227F; + "Scy", `One 0x00421; + "scy", `One 0x00441; + "sdot", `One 0x022C5; + "sdotb", `One 0x022A1; + "sdote", `One 0x02A66; + "searhk", `One 0x02925; + "seArr", `One 0x021D8; + "searr", `One 0x02198; + "searrow", `One 0x02198; + "sect", `One 0x000A7; + "sec", `One 0x000A7; + "semi", `One 0x0003B; + "seswar", `One 0x02929; + "setminus", `One 0x02216; + "setmn", `One 0x02216; + "sext", `One 0x02736; + "Sfr", `One 0x1D516; + "sfr", `One 0x1D530; + "sfrown", `One 0x02322; + "sharp", `One 0x0266F; + "SHCHcy", `One 0x00429; + "shchcy", `One 0x00449; + "SHcy", `One 0x00428; + "shcy", `One 0x00448; + "ShortDownArrow", `One 0x02193; + "ShortLeftArrow", `One 0x02190; + "shortmid", `One 0x02223; + "shortparallel", `One 0x02225; + "ShortRightArrow", `One 0x02192; + "ShortUpArrow", `One 0x02191; + "shy", `One 0x000AD; + "sh", `One 0x000AD; + "Sigma", `One 0x003A3; + "sigma", `One 0x003C3; + "sigmaf", `One 0x003C2; + "sigmav", `One 0x003C2; + "sim", `One 0x0223C; + "simdot", `One 0x02A6A; + "sime", `One 0x02243; + "simeq", `One 0x02243; + "simg", `One 0x02A9E; + "simgE", `One 0x02AA0; + "siml", `One 0x02A9D; + "simlE", `One 0x02A9F; + "simne", `One 0x02246; + "simplus", `One 0x02A24; + "simrarr", `One 0x02972; + "slarr", `One 0x02190; + "SmallCircle", `One 0x02218; + "smallsetminus", `One 0x02216; + "smashp", `One 0x02A33; + "smeparsl", `One 0x029E4; + "smid", `One 0x02223; + "smile", `One 0x02323; + "smt", `One 0x02AAA; + "smte", `One 0x02AAC; + "smtes", `Two (0x02AAC, 0x0FE00); + "SOFTcy", `One 0x0042C; + "softcy", `One 0x0044C; + "sol", `One 0x0002F; + "solb", `One 0x029C4; + "solbar", `One 0x0233F; + "Sopf", `One 0x1D54A; + "sopf", `One 0x1D564; + "spades", `One 0x02660; + "spadesuit", `One 0x02660; + "spar", `One 0x02225; + "sqcap", `One 0x02293; + "sqcaps", `Two (0x02293, 0x0FE00); + "sqcup", `One 0x02294; + "sqcups", `Two (0x02294, 0x0FE00); + "Sqrt", `One 0x0221A; + "sqsub", `One 0x0228F; + "sqsube", `One 0x02291; + "sqsubset", `One 0x0228F; + "sqsubseteq", `One 0x02291; + "sqsup", `One 0x02290; + "sqsupe", `One 0x02292; + "sqsupset", `One 0x02290; + "sqsupseteq", `One 0x02292; + "squ", `One 0x025A1; + "Square", `One 0x025A1; + "square", `One 0x025A1; + "SquareIntersection", `One 0x02293; + "SquareSubset", `One 0x0228F; + "SquareSubsetEqual", `One 0x02291; + "SquareSuperset", `One 0x02290; + "SquareSupersetEqual", `One 0x02292; + "SquareUnion", `One 0x02294; + "squarf", `One 0x025AA; + "squf", `One 0x025AA; + "srarr", `One 0x02192; + "Sscr", `One 0x1D4AE; + "sscr", `One 0x1D4C8; + "ssetmn", `One 0x02216; + "ssmile", `One 0x02323; + "sstarf", `One 0x022C6; + "Star", `One 0x022C6; + "star", `One 0x02606; + "starf", `One 0x02605; + "straightepsilon", `One 0x003F5; + "straightphi", `One 0x003D5; + "strns", `One 0x000AF; + "Sub", `One 0x022D0; + "sub", `One 0x02282; + "subdot", `One 0x02ABD; + "subE", `One 0x02AC5; + "sube", `One 0x02286; + "subedot", `One 0x02AC3; + "submult", `One 0x02AC1; + "subnE", `One 0x02ACB; + "subne", `One 0x0228A; + "subplus", `One 0x02ABF; + "subrarr", `One 0x02979; + "Subset", `One 0x022D0; + "subset", `One 0x02282; + "subseteq", `One 0x02286; + "subseteqq", `One 0x02AC5; + "SubsetEqual", `One 0x02286; + "subsetneq", `One 0x0228A; + "subsetneqq", `One 0x02ACB; + "subsim", `One 0x02AC7; + "subsub", `One 0x02AD5; + "subsup", `One 0x02AD3; + "succ", `One 0x0227B; + "succapprox", `One 0x02AB8; + "succcurlyeq", `One 0x0227D; + "Succeeds", `One 0x0227B; + "SucceedsEqual", `One 0x02AB0; + "SucceedsSlantEqual", `One 0x0227D; + "SucceedsTilde", `One 0x0227F; + "succeq", `One 0x02AB0; + "succnapprox", `One 0x02ABA; + "succneqq", `One 0x02AB6; + "succnsim", `One 0x022E9; + "succsim", `One 0x0227F; + "SuchThat", `One 0x0220B; + "Sum", `One 0x02211; + "sum", `One 0x02211; + "sung", `One 0x0266A; + "Sup", `One 0x022D1; + "sup", `One 0x02283; + "sup1", `One 0x000B9; + "sup", `One 0x000B9; + "sup2", `One 0x000B2; + "sup", `One 0x000B2; + "sup3", `One 0x000B3; + "sup", `One 0x000B3; + "supdot", `One 0x02ABE; + "supdsub", `One 0x02AD8; + "supE", `One 0x02AC6; + "supe", `One 0x02287; + "supedot", `One 0x02AC4; + "Superset", `One 0x02283; + "SupersetEqual", `One 0x02287; + "suphsol", `One 0x027C9; + "suphsub", `One 0x02AD7; + "suplarr", `One 0x0297B; + "supmult", `One 0x02AC2; + "supnE", `One 0x02ACC; + "supne", `One 0x0228B; + "supplus", `One 0x02AC0; + "Supset", `One 0x022D1; + "supset", `One 0x02283; + "supseteq", `One 0x02287; + "supseteqq", `One 0x02AC6; + "supsetneq", `One 0x0228B; + "supsetneqq", `One 0x02ACC; + "supsim", `One 0x02AC8; + "supsub", `One 0x02AD4; + "supsup", `One 0x02AD6; + "swarhk", `One 0x02926; + "swArr", `One 0x021D9; + "swarr", `One 0x02199; + "swarrow", `One 0x02199; + "swnwar", `One 0x0292A; + "szlig", `One 0x000DF; + "szli", `One 0x000DF; + "Tab", `One 0x00009; + "target", `One 0x02316; + "Tau", `One 0x003A4; + "tau", `One 0x003C4; + "tbrk", `One 0x023B4; + "Tcaron", `One 0x00164; + "tcaron", `One 0x00165; + "Tcedil", `One 0x00162; + "tcedil", `One 0x00163; + "Tcy", `One 0x00422; + "tcy", `One 0x00442; + "tdot", `One 0x020DB; + "telrec", `One 0x02315; + "Tfr", `One 0x1D517; + "tfr", `One 0x1D531; + "there4", `One 0x02234; + "Therefore", `One 0x02234; + "therefore", `One 0x02234; + "Theta", `One 0x00398; + "theta", `One 0x003B8; + "thetasym", `One 0x003D1; + "thetav", `One 0x003D1; + "thickapprox", `One 0x02248; + "thicksim", `One 0x0223C; + "ThickSpace", `Two (0x0205F, 0x0200A); + "thinsp", `One 0x02009; + "ThinSpace", `One 0x02009; + "thkap", `One 0x02248; + "thksim", `One 0x0223C; + "THORN", `One 0x000DE; + "THOR", `One 0x000DE; + "thorn", `One 0x000FE; + "thor", `One 0x000FE; + "Tilde", `One 0x0223C; + "tilde", `One 0x002DC; + "TildeEqual", `One 0x02243; + "TildeFullEqual", `One 0x02245; + "TildeTilde", `One 0x02248; + "times", `One 0x000D7; + "time", `One 0x000D7; + "timesb", `One 0x022A0; + "timesbar", `One 0x02A31; + "timesd", `One 0x02A30; + "tint", `One 0x0222D; + "toea", `One 0x02928; + "top", `One 0x022A4; + "topbot", `One 0x02336; + "topcir", `One 0x02AF1; + "Topf", `One 0x1D54B; + "topf", `One 0x1D565; + "topfork", `One 0x02ADA; + "tosa", `One 0x02929; + "tprime", `One 0x02034; + "TRADE", `One 0x02122; + "trade", `One 0x02122; + "triangle", `One 0x025B5; + "triangledown", `One 0x025BF; + "triangleleft", `One 0x025C3; + "trianglelefteq", `One 0x022B4; + "triangleq", `One 0x0225C; + "triangleright", `One 0x025B9; + "trianglerighteq", `One 0x022B5; + "tridot", `One 0x025EC; + "trie", `One 0x0225C; + "triminus", `One 0x02A3A; + "TripleDot", `One 0x020DB; + "triplus", `One 0x02A39; + "trisb", `One 0x029CD; + "tritime", `One 0x02A3B; + "trpezium", `One 0x023E2; + "Tscr", `One 0x1D4AF; + "tscr", `One 0x1D4C9; + "TScy", `One 0x00426; + "tscy", `One 0x00446; + "TSHcy", `One 0x0040B; + "tshcy", `One 0x0045B; + "Tstrok", `One 0x00166; + "tstrok", `One 0x00167; + "twixt", `One 0x0226C; + "twoheadleftarrow", `One 0x0219E; + "twoheadrightarrow", `One 0x021A0; + "Uacute", `One 0x000DA; + "Uacut", `One 0x000DA; + "uacute", `One 0x000FA; + "uacut", `One 0x000FA; + "Uarr", `One 0x0219F; + "uArr", `One 0x021D1; + "uarr", `One 0x02191; + "Uarrocir", `One 0x02949; + "Ubrcy", `One 0x0040E; + "ubrcy", `One 0x0045E; + "Ubreve", `One 0x0016C; + "ubreve", `One 0x0016D; + "Ucirc", `One 0x000DB; + "Ucir", `One 0x000DB; + "ucirc", `One 0x000FB; + "ucir", `One 0x000FB; + "Ucy", `One 0x00423; + "ucy", `One 0x00443; + "udarr", `One 0x021C5; + "Udblac", `One 0x00170; + "udblac", `One 0x00171; + "udhar", `One 0x0296E; + "ufisht", `One 0x0297E; + "Ufr", `One 0x1D518; + "ufr", `One 0x1D532; + "Ugrave", `One 0x000D9; + "Ugrav", `One 0x000D9; + "ugrave", `One 0x000F9; + "ugrav", `One 0x000F9; + "uHar", `One 0x02963; + "uharl", `One 0x021BF; + "uharr", `One 0x021BE; + "uhblk", `One 0x02580; + "ulcorn", `One 0x0231C; + "ulcorner", `One 0x0231C; + "ulcrop", `One 0x0230F; + "ultri", `One 0x025F8; + "Umacr", `One 0x0016A; + "umacr", `One 0x0016B; + "uml", `One 0x000A8; + "um", `One 0x000A8; + "UnderBar", `One 0x0005F; + "UnderBrace", `One 0x023DF; + "UnderBracket", `One 0x023B5; + "UnderParenthesis", `One 0x023DD; + "Union", `One 0x022C3; + "UnionPlus", `One 0x0228E; + "Uogon", `One 0x00172; + "uogon", `One 0x00173; + "Uopf", `One 0x1D54C; + "uopf", `One 0x1D566; + "UpArrow", `One 0x02191; + "Uparrow", `One 0x021D1; + "uparrow", `One 0x02191; + "UpArrowBar", `One 0x02912; + "UpArrowDownArrow", `One 0x021C5; + "UpDownArrow", `One 0x02195; + "Updownarrow", `One 0x021D5; + "updownarrow", `One 0x02195; + "UpEquilibrium", `One 0x0296E; + "upharpoonleft", `One 0x021BF; + "upharpoonright", `One 0x021BE; + "uplus", `One 0x0228E; + "UpperLeftArrow", `One 0x02196; + "UpperRightArrow", `One 0x02197; + "Upsi", `One 0x003D2; + "upsi", `One 0x003C5; + "upsih", `One 0x003D2; + "Upsilon", `One 0x003A5; + "upsilon", `One 0x003C5; + "UpTee", `One 0x022A5; + "UpTeeArrow", `One 0x021A5; + "upuparrows", `One 0x021C8; + "urcorn", `One 0x0231D; + "urcorner", `One 0x0231D; + "urcrop", `One 0x0230E; + "Uring", `One 0x0016E; + "uring", `One 0x0016F; + "urtri", `One 0x025F9; + "Uscr", `One 0x1D4B0; + "uscr", `One 0x1D4CA; + "utdot", `One 0x022F0; + "Utilde", `One 0x00168; + "utilde", `One 0x00169; + "utri", `One 0x025B5; + "utrif", `One 0x025B4; + "uuarr", `One 0x021C8; + "Uuml", `One 0x000DC; + "Uum", `One 0x000DC; + "uuml", `One 0x000FC; + "uum", `One 0x000FC; + "uwangle", `One 0x029A7; + "vangrt", `One 0x0299C; + "varepsilon", `One 0x003F5; + "varkappa", `One 0x003F0; + "varnothing", `One 0x02205; + "varphi", `One 0x003D5; + "varpi", `One 0x003D6; + "varpropto", `One 0x0221D; + "vArr", `One 0x021D5; + "varr", `One 0x02195; + "varrho", `One 0x003F1; + "varsigma", `One 0x003C2; + "varsubsetneq", `Two (0x0228A, 0x0FE00); + "varsubsetneqq", `Two (0x02ACB, 0x0FE00); + "varsupsetneq", `Two (0x0228B, 0x0FE00); + "varsupsetneqq", `Two (0x02ACC, 0x0FE00); + "vartheta", `One 0x003D1; + "vartriangleleft", `One 0x022B2; + "vartriangleright", `One 0x022B3; + "Vbar", `One 0x02AEB; + "vBar", `One 0x02AE8; + "vBarv", `One 0x02AE9; + "Vcy", `One 0x00412; + "vcy", `One 0x00432; + "VDash", `One 0x022AB; + "Vdash", `One 0x022A9; + "vDash", `One 0x022A8; + "vdash", `One 0x022A2; + "Vdashl", `One 0x02AE6; + "Vee", `One 0x022C1; + "vee", `One 0x02228; + "veebar", `One 0x022BB; + "veeeq", `One 0x0225A; + "vellip", `One 0x022EE; + "Verbar", `One 0x02016; + "verbar", `One 0x0007C; + "Vert", `One 0x02016; + "vert", `One 0x0007C; + "VerticalBar", `One 0x02223; + "VerticalLine", `One 0x0007C; + "VerticalSeparator", `One 0x02758; + "VerticalTilde", `One 0x02240; + "VeryThinSpace", `One 0x0200A; + "Vfr", `One 0x1D519; + "vfr", `One 0x1D533; + "vltri", `One 0x022B2; + "vnsub", `Two (0x02282, 0x020D2); + "vnsup", `Two (0x02283, 0x020D2); + "Vopf", `One 0x1D54D; + "vopf", `One 0x1D567; + "vprop", `One 0x0221D; + "vrtri", `One 0x022B3; + "Vscr", `One 0x1D4B1; + "vscr", `One 0x1D4CB; + "vsubnE", `Two (0x02ACB, 0x0FE00); + "vsubne", `Two (0x0228A, 0x0FE00); + "vsupnE", `Two (0x02ACC, 0x0FE00); + "vsupne", `Two (0x0228B, 0x0FE00); + "Vvdash", `One 0x022AA; + "vzigzag", `One 0x0299A; + "Wcirc", `One 0x00174; + "wcirc", `One 0x00175; + "wedbar", `One 0x02A5F; + "Wedge", `One 0x022C0; + "wedge", `One 0x02227; + "wedgeq", `One 0x02259; + "weierp", `One 0x02118; + "Wfr", `One 0x1D51A; + "wfr", `One 0x1D534; + "Wopf", `One 0x1D54E; + "wopf", `One 0x1D568; + "wp", `One 0x02118; + "wr", `One 0x02240; + "wreath", `One 0x02240; + "Wscr", `One 0x1D4B2; + "wscr", `One 0x1D4CC; + "xcap", `One 0x022C2; + "xcirc", `One 0x025EF; + "xcup", `One 0x022C3; + "xdtri", `One 0x025BD; + "Xfr", `One 0x1D51B; + "xfr", `One 0x1D535; + "xhArr", `One 0x027FA; + "xharr", `One 0x027F7; + "Xi", `One 0x0039E; + "xi", `One 0x003BE; + "xlArr", `One 0x027F8; + "xlarr", `One 0x027F5; + "xmap", `One 0x027FC; + "xnis", `One 0x022FB; + "xodot", `One 0x02A00; + "Xopf", `One 0x1D54F; + "xopf", `One 0x1D569; + "xoplus", `One 0x02A01; + "xotime", `One 0x02A02; + "xrArr", `One 0x027F9; + "xrarr", `One 0x027F6; + "Xscr", `One 0x1D4B3; + "xscr", `One 0x1D4CD; + "xsqcup", `One 0x02A06; + "xuplus", `One 0x02A04; + "xutri", `One 0x025B3; + "xvee", `One 0x022C1; + "xwedge", `One 0x022C0; + "Yacute", `One 0x000DD; + "Yacut", `One 0x000DD; + "yacute", `One 0x000FD; + "yacut", `One 0x000FD; + "YAcy", `One 0x0042F; + "yacy", `One 0x0044F; + "Ycirc", `One 0x00176; + "ycirc", `One 0x00177; + "Ycy", `One 0x0042B; + "ycy", `One 0x0044B; + "yen", `One 0x000A5; + "ye", `One 0x000A5; + "Yfr", `One 0x1D51C; + "yfr", `One 0x1D536; + "YIcy", `One 0x00407; + "yicy", `One 0x00457; + "Yopf", `One 0x1D550; + "yopf", `One 0x1D56A; + "Yscr", `One 0x1D4B4; + "yscr", `One 0x1D4CE; + "YUcy", `One 0x0042E; + "yucy", `One 0x0044E; + "Yuml", `One 0x00178; + "yuml", `One 0x000FF; + "yum", `One 0x000FF; + "Zacute", `One 0x00179; + "zacute", `One 0x0017A; + "Zcaron", `One 0x0017D; + "zcaron", `One 0x0017E; + "Zcy", `One 0x00417; + "zcy", `One 0x00437; + "Zdot", `One 0x0017B; + "zdot", `One 0x0017C; + "zeetrf", `One 0x02128; + "ZeroWidthSpace", `One 0x0200B; + "Zeta", `One 0x00396; + "zeta", `One 0x003B6; + "Zfr", `One 0x02128; + "zfr", `One 0x1D537; + "ZHcy", `One 0x00416; + "zhcy", `One 0x00436; + "zigrarr", `One 0x021DD; + "Zopf", `One 0x02124; + "zopf", `One 0x1D56B; + "Zscr", `One 0x1D4B5; + "zscr", `One 0x1D4CF; + "zwj", `One 0x0200D; + "zwnj", `One 0x0200C +|] diff --git a/src/entities/markup_entities.ml b/src/entities/markup_entities.ml new file mode 100644 index 0000000..e1066a7 --- /dev/null +++ b/src/entities/markup_entities.ml @@ -0,0 +1,9 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* Interface module of the [markup.entities] library. It only re-exports the + library's modules so that they are reachable as [Markup_entities.Entities] + and [Markup_entities.Trie]. *) + +module Entities = Entities +module Trie = Trie diff --git a/src/translate_entities/dune b/src/entities/translate_entities/dune similarity index 100% rename from src/translate_entities/dune rename to src/entities/translate_entities/dune diff --git a/src/translate_entities/translate_entities.ml b/src/entities/translate_entities/translate_entities.ml similarity index 96% rename from src/translate_entities/translate_entities.ml rename to src/entities/translate_entities/translate_entities.ml index 117e13f..99c33aa 100644 --- a/src/translate_entities/translate_entities.ml +++ b/src/entities/translate_entities/translate_entities.ml @@ -22,7 +22,7 @@ let () = print_string "(string * [ `One of int | `Two of int * int ]) array"; print_string " = [|\n "; - Yojson.Basic.from_file "src/entities.json" + Yojson.Basic.from_file "src/entities/entities.json" |> to_assoc |> List.map (fun (k, v) -> let k = String.sub k 1 (String.length k - 2) in diff --git a/src/entities/trie.ml b/src/entities/trie.ml new file mode 100644 index 0000000..27713c4 --- /dev/null +++ b/src/entities/trie.ml @@ -0,0 +1,79 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* Tries. These aren't fully functional nor fully mutable. To accumulate a trie, + it is necessary to retain the latest result of [add]. However, previous tries + become invalid after [add]. *) + +type 'a trie = + | Empty + | Leaf of 'a + | Node of 'a option * 'a trie array + +let lower_limit = Char.code '0' +let upper_limit = Char.code 'z' +let array_size = upper_limit - lower_limit + 1 + +let create () = + Empty + +let edge_index c = + Char.code c - lower_limit + +let add key value trie = + let rec traverse index trie = + if index >= String.length key then + match trie with + | Empty | Leaf _ -> Leaf value + | Node (_, children) -> Node (Some value, children) + + else + let edge_index = edge_index key.[index] in + let value', children, current_child = + match trie with + | Empty -> None, None, Empty + | Leaf v -> Some v, None, Empty + | Node (v, children) -> v, Some children, children.(edge_index) + in + let child = traverse (index + 1) current_child in + let children = + match children with + | None -> + Array.init array_size (fun i -> + if i = edge_index then child else Empty) + | Some children -> + children.(edge_index) <- child; + children + in + Node (value', children) + in + + traverse 0 trie + +type 'a match_ = + | No + | Yes of 'a + | Prefix + | Multiple of 'a + +let matches = function + | Empty -> No + | Leaf v -> Yes v + | Node (None, _) -> Prefix + | Node (Some v, _) -> Multiple v + +let advance c = function + | Empty | Leaf _ -> Empty + | Node (_, children) -> + if c < lower_limit || c > upper_limit then Empty + else children.(c - lower_limit) + +let guess_memory_usage trie = + let rec accumulate words = function + | Empty -> words + 1 + | Leaf _ -> words + 2 + | Node (_, children) -> + let words = words + 4 + Array.length children in + Array.fold_left accumulate words children + in + accumulate 0 trie diff --git a/src/error.ml b/src/error.ml index e29fd12..85d1068 100644 --- a/src/error.ml +++ b/src/error.ml @@ -1,74 +1,9 @@ (* This file is part of Markup.ml, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) -open Common - -type t = - [ `Decoding_error of string * string - | `Bad_token of string * string * string - | `Unexpected_eoi of string - | `Bad_document of string - | `Unmatched_start_tag of string - | `Unmatched_end_tag of string - | `Bad_namespace of string - | `Misnested_tag of string * string * (string * string) list - | `Bad_content of string ] - -let explode_string s = - let rec iterate index acc = - if index >= String.length s then List.rev acc - else iterate (index + 1) (s.[index]::acc) - in - iterate 0 [] - -let to_string ?location error = - let fmt = Printf.sprintf in - - let message = - match error with - | `Decoding_error (bytes, encoding) -> - begin match String.length bytes with - | 0 -> - fmt "bad bytes for encoding '%s'" encoding - | 1 -> - fmt "bad byte '0x%02X' for encoding '%s'" (Char.code bytes.[0]) encoding - | _ -> - fmt "bad bytes '%s' for encoding '%s'" - (explode_string bytes - |> List.map Char.code - |> List.map (fmt "0x%02X") - |> String.concat " ") - encoding - end - - | `Bad_token (s, production, reason) -> - fmt "bad token '%s' in %s: %s" s production reason - - | `Unexpected_eoi in_ -> - fmt "unexpected end of input in %s" in_ +include Markup_common.Error - | `Bad_document reason -> - fmt "bad document: %s" reason - - | `Unmatched_start_tag s -> - fmt "unmatched start tag '%s'" s - - | `Unmatched_end_tag s -> - fmt "unmatched end tag '%s'" s - - | `Bad_namespace s -> - fmt "unknown namespace '%s'" s - - | `Misnested_tag (s, in_, _attributes) -> - fmt "misnested tag: '%s' in '%s'" s in_ - - | `Bad_content s -> - fmt "bad content in '%s'" s - in - - match location with - | None -> message - | Some (line, column) -> fmt "line %i, column %i: %s" line column message +open Common type 'a handler = 'a -> t -> unit cps type parse_handler = location handler diff --git a/src/kstream.ml b/src/kstream.ml index aa61f82..6680a76 100644 --- a/src/kstream.ml +++ b/src/kstream.ml @@ -1,133 +1,6 @@ (* This file is part of Markup.ml, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) -open Common +(* See the comment in common.ml. *) -type 'a t = {mutable f : exn cont -> unit cont -> 'a cont -> unit} - -let make f = {f} - -let construct c = - let s = ref None in - (fun throw e k -> - match !s with - | None -> c throw (fun s' -> s := Some s'; s'.f throw e k) - | Some s' -> s'.f throw e k) - |> make - -let empty () = (fun _ e _ -> e ()) |> make - -let next {f} throw e k = f throw e k - -let next_option {f} throw k = f throw (fun () -> k None) (fun v -> k (Some v)) - -let next_expected {f} throw k = - f throw (fun () -> throw (Failure "stream empty")) k - -let next_n n s throw k = - if n < 0 then throw (Invalid_argument "n is negative") - else - let rec iterate acc = function - | 0 -> k (List.rev acc) - | n -> - next s throw - (fun () -> iterate acc 0) (fun v -> iterate (v::acc) (n - 1)) - in - - iterate [] n - -let push ({f} as s) v = s.f <- fun _ _ k -> s.f <- f; k v - -let push_option s = function - | None -> () - | Some v -> push s v - -let push_list ({f} as s) = function - | [] -> () - | vs -> - let remainder = ref vs in - s.f <- fun throw e k -> - match !remainder with - | [] -> s.f <- f; f throw e k - | v::vs -> remainder := vs; k v - -let peek s throw e k = next s throw e (fun v -> push s v; k v) - -let peek_option s throw k = - peek s throw (fun () -> k None) (fun v -> k (Some v)) - -let peek_expected s throw k = - peek s throw (fun () -> throw (Failure "stream empty")) k - -let peek_n n s throw k = next_n n s throw (fun vs -> push_list s vs; k vs) - -let tap g ({f} as s) = - (s.f <- fun throw e k -> f throw e (fun v -> g v; k v)); - fun () -> s.f <- f - -let checkpoint s = - let buffer = ref [] in - let s' = - (fun throw e k -> - s.f throw e (fun v -> buffer := v::!buffer; k v)) - |> make - in - let restore () = push_list s (List.rev !buffer) in - s', restore - -let transform f init s = - let current_acc = ref (Some init) in - let to_emit = ref [] in - let rec operate throw e k = - match !to_emit with - | v::more -> to_emit := more; k v - | [] -> - match !current_acc with - | None -> e () - | Some acc -> - next s throw e (fun v -> - f acc v throw (fun (vs, acc') -> - to_emit := vs; - current_acc := acc'; - operate throw e k)) - in - make operate - -let map f s = (fun throw e k -> next s throw e (fun v -> f v throw k)) |> make - -let rec fold f v s throw k = - next s throw - (fun () -> k v) - (fun v' -> f v v' throw (fun v'' -> fold f v'' s throw k)) - -let iter f s throw k = fold (fun () v throw k -> f v throw k) () s throw k - -let filter_map f s = - let rec emit throw e k = - next s throw e (fun v -> - f v throw (function - | None -> emit throw e k - | Some v -> k v)) - in - make emit - -let filter f s = - s |> filter_map (fun v throw k -> - f v throw (function - | true -> k (Some v) - | false -> k None)) - -let of_list l = - let l = ref l in - (fun _ e k -> - match !l with - | [] -> e () - | v::l' -> l := l'; k v) - |> make - -let to_list s throw k = - fold (fun l v _ k -> k (v::l)) [] s throw (fun l -> k (List.rev l)) - -let enumerate s = - let index = ref 0 in - s |> map (fun v _ k -> index := !index + 1; k ((!index - 1), v)) +include Markup_common.Kstream diff --git a/src/markup.ml b/src/markup.ml index ab4e1c3..2bd34d4 100644 --- a/src/markup.ml +++ b/src/markup.ml @@ -24,13 +24,17 @@ module Synchronous : IO with type 'a t = 'a = struct let to_cps f throw k = match f () with v -> k v | exception exn -> throw exn end -type async = unit -type sync = unit -type ('data, 'sync) stream = 'data Kstream.t +type async = Markup_common.async +type sync = Markup_common.sync -let kstream s = s -let of_kstream s = s -let of_list = Kstream.of_list +(* [stream] is defined by the markup.common library, so that streams can be + exchanged with the other libraries built on it. [Kstream] is this library's + own stream implementation; both conversions below are the identity. *) +type ('data, 'sync) stream = ('data, 'sync) Markup_common.stream + +let kstream = Markup_common.Stream.Private.of_stream +let of_kstream = Markup_common.Stream.Private.to_stream +let of_list l = Kstream.of_list l |> of_kstream type location = Common.location @@ -60,10 +64,10 @@ let signal_to_string = Common.signal_to_string type 's parser = { mutable location : location; - mutable signals : (signal, 's) stream; + mutable signals : signal Kstream.t; } -let signals parser = parser.signals +let signals parser = of_kstream parser.signals let location parser = parser.location let stream_to_parser s = @@ -77,6 +81,7 @@ let stream_to_parser s = module Cps = struct let parse_xml report ?encoding namespace entity context source = + let source = kstream source in let with_encoding (encoding : Encoding.t) k = source |> encoding ~report |> Input.preprocess Common.is_valid_xml_char report @@ -96,7 +101,10 @@ module Cps = struct Kstream.construct constructor |> stream_to_parser let write_xml report prefix signals = - signals |> Xml_writer.write report prefix |> Utility.strings_to_bytes + signals |> kstream + |> Xml_writer.write report prefix + |> Utility.strings_to_bytes + |> of_kstream let parse_tokens ?depth_limit report context tokens = let tokens = Kstream.of_list tokens in @@ -106,6 +114,7 @@ module Cps = struct stream_to_parser signals let parse_html report ?depth_limit ?encoding context source = + let source = kstream source in let with_encoding (encoding : Encoding.t) k = source |> encoding ~report |> Input.preprocess Common.is_valid_html_char report @@ -124,22 +133,52 @@ module Cps = struct Kstream.construct constructor |> stream_to_parser let write_html ?escape_attribute ?escape_text signals = - signals + signals |> kstream |> Html_writer.write ?escape_attribute ?escape_text |> Utility.strings_to_bytes + |> of_kstream end -let string = Stream_io.string -let buffer = Stream_io.buffer -let channel = Stream_io.channel -let file = Stream_io.file -let to_channel c bytes = Stream_io.to_channel c bytes |> Synchronous.of_cps -let to_file f bytes = Stream_io.to_file f bytes |> Synchronous.of_cps +let string s = Stream_io.string s |> of_kstream +let buffer b = Stream_io.buffer b |> of_kstream +let channel c = Stream_io.channel c |> of_kstream -let preprocess_input_stream source = - Input.preprocess (fun _ -> true) Error.ignore_errors source +let file f = + let s, close = Stream_io.file f in + (of_kstream s, close) + +let to_channel c bytes = + Stream_io.to_channel c (kstream bytes) |> Synchronous.of_cps + +let to_file f bytes = Stream_io.to_file f (kstream bytes) |> Synchronous.of_cps -include Utility +let preprocess_input_stream source = + let signals, get_location = + Input.preprocess (fun _ -> true) Error.ignore_errors (kstream source) + in + (of_kstream signals, get_location) + +type 'a node = 'a Utility.node + +let content s = Utility.content (kstream s) |> of_kstream +let strings_to_bytes s = Utility.strings_to_bytes (kstream s) |> of_kstream +let text s = Utility.text (kstream s) |> of_kstream +let trim s = Utility.trim (kstream s) |> of_kstream +let normalize_text s = Utility.normalize_text (kstream s) |> of_kstream +let pretty_print s = Utility.pretty_print (kstream s) |> of_kstream +let html5 s = Utility.html5 (kstream s) |> of_kstream +let xhtml ?dtd s = Utility.xhtml ?dtd (kstream s) |> of_kstream +let xhtml_entity = Utility.xhtml_entity +let from_tree f v = Utility.from_tree f v |> of_kstream + +let trees ?text ?element ?comment ?pi ?xml ?doctype s = + Utility.trees ?text ?element ?comment ?pi ?xml ?doctype (kstream s) + |> of_kstream + +let elements f s = + Utility.elements f (kstream s) + |> Kstream.map (fun sub _ k -> k (of_kstream sub)) + |> of_kstream module Ns = struct let html = Common.html_ns @@ -232,7 +271,7 @@ module Asynchronous (IO : IO) = struct include Encoding let decode ?(report = fun _ _ -> IO.return ()) (f : Encoding.t) s = - f ~report:(wrap_report report) s + f ~report:(wrap_report report) (kstream s) |> of_kstream end let parse_xml ?(report = fun _ _ -> IO.return ()) ?encoding @@ -255,44 +294,57 @@ module Asynchronous (IO : IO) = struct let write_html ?escape_attribute ?escape_text signals = Cps.write_html ?escape_attribute ?escape_text signals - let to_string bytes = Stream_io.to_string bytes |> IO.of_cps - let to_buffer bytes = Stream_io.to_buffer bytes |> IO.of_cps + let to_string bytes = Stream_io.to_string (kstream bytes) |> IO.of_cps + let to_buffer bytes = Stream_io.to_buffer (kstream bytes) |> IO.of_cps let stream f = let f = IO.to_cps f in (fun throw e k -> f throw (function None -> e () | Some v -> k v)) |> Kstream.make + |> of_kstream let fn = stream - let next s = Kstream.next_option s |> IO.of_cps - let peek s = Kstream.peek_option s |> IO.of_cps + let next s = Kstream.next_option (kstream s) |> IO.of_cps + let peek s = Kstream.peek_option (kstream s) |> IO.of_cps (* Without Flambda, thunks are repeatedly created and passed on IO.to_cps, resulting in a performance penalty. Flambda seems to optimize this away, however. *) let transform f v s = - Kstream.transform (fun v s -> IO.to_cps (fun () -> f v s)) v s + Kstream.transform (fun v s -> IO.to_cps (fun () -> f v s)) v (kstream s) + |> of_kstream let fold f v s = - Kstream.fold (fun v v' -> IO.to_cps (fun () -> f v v')) v s |> IO.of_cps + Kstream.fold (fun v v' -> IO.to_cps (fun () -> f v v')) v (kstream s) + |> IO.of_cps + + let map f s = + Kstream.map (fun v -> IO.to_cps (fun () -> f v)) (kstream s) |> of_kstream - let map f s = Kstream.map (fun v -> IO.to_cps (fun () -> f v)) s - let filter f s = Kstream.filter (fun v -> IO.to_cps (fun () -> f v)) s - let filter_map f s = Kstream.filter_map (fun v -> IO.to_cps (fun () -> f v)) s + let filter f s = + Kstream.filter (fun v -> IO.to_cps (fun () -> f v)) (kstream s) + |> of_kstream + + let filter_map f s = + Kstream.filter_map (fun v -> IO.to_cps (fun () -> f v)) (kstream s) + |> of_kstream let iter f s = - Kstream.iter (fun v -> IO.to_cps (fun () -> f v)) s |> IO.of_cps + Kstream.iter (fun v -> IO.to_cps (fun () -> f v)) (kstream s) |> IO.of_cps let drain s = iter (fun _ -> IO.return ()) s - let to_list s = Kstream.to_list s |> IO.of_cps + let to_list s = Kstream.to_list (kstream s) |> IO.of_cps let load s = - (fun throw k -> Kstream.to_list s throw (fun l -> k (Kstream.of_list l))) + (fun throw k -> + Kstream.to_list (kstream s) throw (fun l -> + k (of_kstream (Kstream.of_list l)))) |> IO.of_cps let tree ?text ?element ?comment ?pi ?xml ?doctype s = - Utility.tree ?text ?element ?comment ?pi ?xml ?doctype s |> IO.of_cps + Utility.tree ?text ?element ?comment ?pi ?xml ?doctype (kstream s) + |> IO.of_cps end include Asynchronous (Synchronous) diff --git a/src/markup.mli b/src/markup.mli index 89b1406..9d0c928 100644 --- a/src/markup.mli +++ b/src/markup.mli @@ -86,14 +86,18 @@ val write_xml : signal stream -> char stream (** {2 Streams} *) -type async -type sync +type async = Markup_common.async +type sync = Markup_common.sync (** Phantom types for use with [('a, 's) stream] in place of ['s]. See explanation below. *) -type ('a, 's) stream +type ('a, 's) stream = ('a, 's) Markup_common.stream (** Streams of elements of type ['a]. + This is the same type as {!Markup_common.stream}, so that streams can be + exchanged with other libraries built on [markup.common], such as + [markup.tiny]. + In simple usage, when using only this module [Markup], the additional type parameter ['s] is always [sync], and there is no need to consider it further. @@ -115,7 +119,7 @@ type ('a, 's) stream debug parser output, use optional argument [?report] of the parsers, and look in module {!Error}. *) -type location = int * int +type location = Markup_common.location (** Line and column for parsing errors. Both numbers are one-based. *) (** Error type and [to_string] function. *) @@ -227,17 +231,17 @@ end (** {2 Signals} *) -type name = string * string +type name = Markup_common.name (** Expanded name: a namespace URI followed by a local name. *) -type xml_declaration = +type xml_declaration = Markup_common.xml_declaration = {version : string; encoding : string option; standalone : bool option} (** Representation of an XML declaration, i.e. []. *) -type doctype = +type doctype = Markup_common.doctype = {doctype_name : string option; public_identifier : string option; system_identifier : string option; @@ -972,7 +976,7 @@ val preprocess_input_stream : (* Exposing some internal types and functions to allow sane integration *) module Internals : sig - type location = int * int + type location = Markup_common.location module Token_tag : sig type t = diff --git a/src/trie.ml b/src/trie.ml index 27713c4..432cb4e 100644 --- a/src/trie.ml +++ b/src/trie.ml @@ -1,79 +1,6 @@ (* This file is part of Markup.ml, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) -(* Tries. These aren't fully functional nor fully mutable. To accumulate a trie, - it is necessary to retain the latest result of [add]. However, previous tries - become invalid after [add]. *) +(* See the comment in entities.ml. *) -type 'a trie = - | Empty - | Leaf of 'a - | Node of 'a option * 'a trie array - -let lower_limit = Char.code '0' -let upper_limit = Char.code 'z' -let array_size = upper_limit - lower_limit + 1 - -let create () = - Empty - -let edge_index c = - Char.code c - lower_limit - -let add key value trie = - let rec traverse index trie = - if index >= String.length key then - match trie with - | Empty | Leaf _ -> Leaf value - | Node (_, children) -> Node (Some value, children) - - else - let edge_index = edge_index key.[index] in - let value', children, current_child = - match trie with - | Empty -> None, None, Empty - | Leaf v -> Some v, None, Empty - | Node (v, children) -> v, Some children, children.(edge_index) - in - let child = traverse (index + 1) current_child in - let children = - match children with - | None -> - Array.init array_size (fun i -> - if i = edge_index then child else Empty) - | Some children -> - children.(edge_index) <- child; - children - in - Node (value', children) - in - - traverse 0 trie - -type 'a match_ = - | No - | Yes of 'a - | Prefix - | Multiple of 'a - -let matches = function - | Empty -> No - | Leaf v -> Yes v - | Node (None, _) -> Prefix - | Node (Some v, _) -> Multiple v - -let advance c = function - | Empty | Leaf _ -> Empty - | Node (_, children) -> - if c < lower_limit || c > upper_limit then Empty - else children.(c - lower_limit) - -let guess_memory_usage trie = - let rec accumulate words = function - | Empty -> words + 1 - | Leaf _ -> words + 2 - | Node (_, children) -> - let words = words + 4 + Array.length children in - Array.fold_left accumulate words children - in - accumulate 0 trie +include Markup_entities.Trie From e4dc083ad6071ae66164a392dae289b1fa0a4a03 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 15:48:52 -0400 Subject: [PATCH 004/109] salvage ragel tokenizer from git history for testing purposes --- src/dune | 2 +- test/dune | 2 +- test/ragel_html_tokenizer.ml | 44 ++++++++++++++++++++++++++++++++++++ test/test.ml | 2 +- test/test_ragel_parser.ml | 5 ++-- test/test_ragel_tokenizer.ml | 35 ++++++++++++++++++++++++++++ 6 files changed, 85 insertions(+), 5 deletions(-) create mode 100644 test/ragel_html_tokenizer.ml create mode 100644 test/test_ragel_tokenizer.ml diff --git a/src/dune b/src/dune index 5697f4c..7ea458c 100644 --- a/src/dune +++ b/src/dune @@ -4,7 +4,7 @@ (synopsis "Error-recovering functional HTML5 and XML parsers") (instrumentation (backend bisect_ppx)) - (libraries devkit uutf markup.common markup.entities) + (libraries uutf markup.common markup.entities) (flags (:standard -w -9))) diff --git a/test/dune b/test/dune index 69f30da..029607e 100644 --- a/test/dune +++ b/test/dune @@ -1,6 +1,6 @@ (executable (name test) - (libraries markup ounit2 test_support)) + (libraries markup devkit ounit2 test_support)) (rule (alias runtest) diff --git a/test/ragel_html_tokenizer.ml b/test/ragel_html_tokenizer.ml new file mode 100644 index 0000000..d2ef737 --- /dev/null +++ b/test/ragel_html_tokenizer.ml @@ -0,0 +1,44 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Markup__Common + +module HS = Devkit.HtmlStream + +let decode raw = + let inner = HS.Raw.project raw in + try Devkit.Web.htmldecode inner with _ -> inner + +let tokenize html : (location * Markup__Html_tokenizer.token) list = + let ctx = HS.init () in + let tokens = ref [] in + let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in + let attributes attrs = + List.rev_map (fun (name, value) -> name, decode value) attrs + in + let tag name attributes = + {Token_tag.name; attributes; self_closing = false} + in + let step = function + | HS.Text raw -> + emit (`String (decode raw)) + | HS.Tag (name, attrs) -> + emit (`Start (tag name (attributes attrs))) + | HS.Close "br" -> + (* [HtmlStream] emits both [Tag "br"] and [Close "br"] for [
]. + Feeding the close token to the tree builder creates a second [br]. *) + () + | HS.Close name -> + emit (`End (tag name [])) + | HS.Script (attrs, text) -> + emit (`Start (tag "script" (attributes attrs))); + emit (`String text); + emit (`End (tag "script" [])) + | HS.Style (attrs, text) -> + emit (`Start (tag "style" (attributes attrs))); + emit (`String text); + emit (`End (tag "style" [])) + in + HS.parse ~ctx step html; + emit `EOF; + List.rev !tokens diff --git a/test/test.ml b/test/test.ml index 8cace4f..c5f4544 100644 --- a/test/test.ml +++ b/test/test.ml @@ -21,7 +21,7 @@ let suite = Test_detect.tests; Test_utility.tests; Test_integration.tests; - (* Test_ragel_tokenizer.tests; *) + Test_ragel_tokenizer.tests; (* Test_ragel_parser.tests; *) ] diff --git a/test/test_ragel_parser.ml b/test/test_ragel_parser.ml index b6438ef..02b2018 100644 --- a/test/test_ragel_parser.ml +++ b/test/test_ragel_parser.ml @@ -1,7 +1,6 @@ open OUnit2 open Test_support open Markup__Common -module Error = Markup__Error module Kstream = Markup__Kstream let print_token_stream stream = @@ -45,7 +44,9 @@ let expect ?prefix ?(context = Some `Document) text signals = expect_no_location_signals ?prefix signal_to_string text signals in - let token_stream = Markup__Html_tokenizer.Ragel.tokenize text in + let token_stream = + text |> Ragel_html_tokenizer.tokenize |> Kstream.of_list + in let signal_stream = Markup__Html_parser.parse context report (token_stream, ignore, ignore) diff --git a/test/test_ragel_tokenizer.ml b/test/test_ragel_tokenizer.ml new file mode 100644 index 0000000..e50d999 --- /dev/null +++ b/test/test_ragel_tokenizer.ml @@ -0,0 +1,35 @@ +open OUnit2 + +let tag name attributes : Markup__Common.Token_tag.t = + {name; attributes; self_closing = false} + +let tokens_without_locations html = + html |> Ragel_html_tokenizer.tokenize |> List.map snd + +let tests = + [ + ( "private.html-tokenize.tokens" >:: fun _ -> + let actual = + tokens_without_locations + "

<

" + in + let expected : Markup__Html_tokenizer.token list = + [ + `Start (tag "br" []); + `Start (tag "p" ["a", "&"]); + `String "<"; + `End (tag "p" []); + `Start (tag "script" []); + `String "&"; + `End (tag "script" []); + `Start (tag "style" []); + `String "x"; + `End (tag "style" []); + `EOF; + ] + in + assert_equal expected actual ); + ( "private.html-tokenize.locations" >:: fun _ -> + let actual = Ragel_html_tokenizer.tokenize "one\ntwo" in + assert_equal [((2, -1), `String "one\ntwo"); ((2, -1), `EOF)] actual ); + ] From 50a002a2b42dd0aef496d6d7e2d9f18a91be86d7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 16:45:56 -0400 Subject: [PATCH 005/109] copy HTML parser for markup.lite --- src/lite/html_parser.ml | 2932 ++++++++++++++++++++++++++++++++++++++ src/lite/html_parser.mli | 13 + 2 files changed, 2945 insertions(+) create mode 100644 src/lite/html_parser.ml create mode 100644 src/lite/html_parser.mli diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml new file mode 100644 index 0000000..b7b3bbf --- /dev/null +++ b/src/lite/html_parser.ml @@ -0,0 +1,2932 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common +open Token_tag +open Kstream + + + +(* Namespaces for pattern matching. *) +type ns = [ `HTML | `MathML | `SVG | `Other of string ] +type qname = ns * string + +module Ns : +sig + val to_string : ns -> string +end = +struct + let to_string = function + | `HTML -> html_ns + | `MathML -> mathml_ns + | `SVG -> svg_ns + | `Other s -> s +end + +(* Specialization of List.mem at qname list, to avoid polymorphic + comparison. *) +let list_mem_qname ((ns, tag) : qname) l = + let rec loop = function + | [] -> false + | (ns', tag')::_ when ns' = ns && tag' = tag -> true + | _::rest -> loop rest + in + loop l + + + +(* Elements. *) +type element = + {element_name : qname; + location : location; + is_html_integration_point : bool; + suppress : bool; + mutable buffering : bool; + mutable is_open : bool; + mutable attributes : (name * string) list; + mutable end_location : location; + mutable children : annotated_node list; + mutable parent : element} + +and node = + | Element of element + | Text of string list + | PI of string * string + | Comment of string + +and annotated_node = location * node + + + +(* Element helpers. *) +module Element : +sig + val create : + ?is_html_integration_point:bool -> + ?suppress:bool -> + qname -> location -> + element + val dummy : element + + val is_special : qname -> bool + val is_not_hidden : Token_tag.t -> bool +end = +struct + let rec dummy = + {element_name = `HTML, "dummy"; + location = 1, 1; + is_html_integration_point = false; + suppress = true; + buffering = false; + is_open = false; + attributes = []; + end_location = 1, 1; + children = []; + parent = dummy} + + let create + ?(is_html_integration_point = false) ?(suppress = false) name location = + {element_name = name; + location; + is_html_integration_point; + suppress; + buffering = false; + is_open = true; + attributes = []; + end_location = 1, 1; + children = []; + parent = dummy} + + let is_special name = + list_mem_qname name + [`HTML, "address"; `HTML, "applet"; `HTML, "area"; + `HTML, "article"; `HTML, "aside"; `HTML, "base"; + `HTML, "basefont"; `HTML, "bgsound"; `HTML, "blockquote"; + `HTML, "body"; `HTML, "br"; `HTML, "button"; + `HTML, "caption"; `HTML, "center"; `HTML, "col"; + `HTML, "colgroup"; `HTML, "dd"; `HTML, "details"; + `HTML, "dir"; `HTML, "div"; `HTML, "dl"; + `HTML, "dt"; `HTML, "embed"; `HTML, "fieldset"; + `HTML, "figcaption"; `HTML, "figure"; `HTML, "footer"; + `HTML, "form"; `HTML, "frame"; `HTML, "frameset"; + `HTML, "h1"; `HTML, "h2"; `HTML, "h3"; + `HTML, "h4"; `HTML, "h5"; `HTML, "h6"; + `HTML, "head"; `HTML, "header"; `HTML, "hgroup"; + `HTML, "hr"; `HTML, "html"; `HTML, "iframe"; + `HTML, "img"; `HTML, "input"; `HTML, "isindex"; + `HTML, "li"; `HTML, "link"; `HTML, "listing"; + `HTML, "main"; `HTML, "marquee"; `HTML, "meta"; + `HTML, "nav"; `HTML, "noembed"; `HTML, "noframes"; + `HTML, "noscript"; `HTML, "object"; `HTML, "ol"; + `HTML, "p"; `HTML, "param"; `HTML, "plaintext"; + `HTML, "pre"; `HTML, "script"; `HTML, "section"; + `HTML, "select"; `HTML, "source"; `HTML, "style"; + `HTML, "summary"; `HTML, "table"; `HTML, "tbody"; + `HTML, "td"; `HTML, "template"; `HTML, "textarea"; + `HTML, "tfoot"; `HTML, "th"; `HTML, "thead"; + `HTML, "title"; `HTML, "tr"; `HTML, "track"; + `HTML, "ul"; `HTML, "wbr"; `HTML, "xmp"; + `MathML, "mi"; `MathML, "mo"; `MathML, "mn"; + `MathML, "ms"; `MathML, "mtext"; `MathML, "annotation-xml"; + `SVG, "foreignObject"; `SVG, "desc"; `SVG, "title"] + + let is_not_hidden tag = + tag.Token_tag.attributes |> List.exists (fun (name, value) -> + name = "type" && value <> "hidden") +end + + + +(* Context detection. *) +type simple_context = [ `Document | `Fragment of string ] +type context = [ `Document | `Fragment of qname ] + +module Context : +sig + type t + + val uninitialized : unit -> t + val initialize : + (location * Html_tokenizer.token) Kstream.t -> + [< simple_context ] option -> + t -> + unit cps + + val the_context : t -> context + val element : t -> element option + val token : t -> string option +end = +struct + let detect tokens throw k = + let tokens, restore = checkpoint tokens in + + let last_name = ref None in + let next_token k = + next_expected tokens throw (fun token -> + begin match token with + | _, `Start {name} -> last_name := Some name + | _ -> () + end; + k token) + in + + let k context = restore (); k (context, !last_name) in + + let rec scan () = + next_token begin function + | _, `Doctype _ -> k `Document + | _, `String s when not @@ is_whitespace_only s -> k (`Fragment "body") + | _, `String _ -> scan () + | _, `Char c when not @@ is_whitespace c -> k (`Fragment "body") + | _, `Char _ -> scan () + | _, `EOF -> k (`Fragment "body") + | _, `Start {name = "html"} -> k `Document + | _, `Start {name = "head" | "body" | "frameset"} -> + k (`Fragment "html") + | _, `Start {name = + "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | + "style" | "template" | "title"} -> + k (`Fragment "head") + | _, `Start {name = "frame"} -> k (`Fragment "frameset") + | _, `Start {name = "li"} -> k (`Fragment "ul") + | _, `Start {name = + "caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead"} -> + k (`Fragment "table") + | _, `Start {name = "tr"} -> k (`Fragment "tbody") + | _, `Start {name = "td" | "th"} -> k (`Fragment "tr") + | _, `Start {name = "optgroup" | "option"} -> k (`Fragment "select") + | _, `Start {name = + "altglyph" | "altglyphdef" | "altglyphitem" | "animate" | + "animatecolor" | "animatemotion" | "animatetransform" | "circle" | + "clippath" | "color-profile" | "cursor" | "defs" | "desc" | + "ellipse" | "feblend" | "fecolormatrix" | "fecomponenttransfer" | + "fecomposite" | "fediffuselighting" | "fedisplacementmap" | + "fedistantlight" | "feflood" | "fefunca" | "fefuncb" | "fefuncg" | + "fefuncr" | "fegaussianblur" | "feimage" | "femerge" | + "femergenode" | "femorphology" | "feoffset" | "fepointlight" | + "fespecularlighting" | "fespotlight" | "fetile" | "feturbulence" | + "filter" | "font-face" | "font-face-format" | "font-face-name" | + "font-face-src" | "font-face-uri" | "foreignobject" | "g" | + "glyph" | "glyphref" | "hkern" | "image" | "line" | + "lineargradient" | "marker" | "mask" | "metadata" | + "missing-glyph" | "mpath" | "path" | "pattern" | "polygon" | + "polyline" | "radialgradient" | "rect" | "set" | "stop" | "switch" | + "symbol" | "text" | "textpath" | "tref" | "tspan" | "use"} -> + k (`Fragment "svg") + | _, `Start {name = + "maction" | "maligngroup" | "malignmark" | "menclose" | "merror" | + "mfenced" | "mfrac" | "mglyph" | "mi" | "mlabeledtr" | "mlongdiv" | + "mmultiscripts" | "mn" | "mo" | "mover" | "mpadded" | "mphantom" | + "mroot" | "mrow" | "ms" | "mscarries" | "mscarry" | "msgroup" | + "msline" | "mspace" | "msqrt" | "msrow" | "mstack" | "mstyle" | + "msub" | "msup" | "msubsup" | "mtable" | "mtd" | "mtext" | "mtr" | + "munder" | "munderover" | "semantics" | "annotation" | + "annotation-xml"} -> + k (`Fragment "math") + | _, `Start _ -> k (`Fragment "body") + | _, (`End _ | `Comment _) -> scan () + end + in + + scan () + + type t = (context * element option * string option) ref + + let uninitialized () = ref (`Document, None, None) + + let initialize tokens requested_context state throw k = + (fun k -> + match requested_context with + | Some (`Fragment element) -> + (* HTML element names are case-insensitive, even in foreign content. + Lowercase the element name given by the user before analysis by the + parser, to match this convention. [String.lowercase] is acceptable + here because the API assumes the string [element] is in UTF-8. *) + k (`Fragment (String.lowercase_ascii element), None) + | Some (`Document as c) -> k (c, None) + | None -> detect tokens throw k) + (fun (detected_context, deciding_token) -> + + let context = + match detected_context with + | `Document -> `Document + | `Fragment "math" -> `Fragment (`MathML, "math") + | `Fragment "svg" -> `Fragment (`SVG, "svg") + | `Fragment name -> `Fragment (`HTML, name) + in + + let context_element = + match context with + | `Document -> None + | `Fragment name -> + let is_html_integration_point = + match name with + | `SVG, ("foreignObject" | "desc" | "title") -> true + | _ -> false + in + + Some (Element.create + ~is_html_integration_point ~suppress:true name (1, 1)) + in + + state := context, context_element, deciding_token; + + k ()) + + let the_context {contents = (c, _, _)} = c + let element {contents = (_, e, _)} = e + let token {contents = (_, _, t)} = t +end + + + +(* Heplers for foreign content. *) +module Foreign : +sig + val is_mathml_text_integration_point : qname -> bool + val is_html_integration_point : + ns -> string -> (string * string) list -> bool + + val adjust_mathml_attributes : + ((string * string) * string) list -> ((string * string) * string) list + val adjust_svg_attributes : + ((string * string) * string) list -> ((string * string) * string) list + val adjust_svg_tag_name : string -> string +end = +struct + let is_mathml_text_integration_point qname = + list_mem_qname qname + [`MathML, "mi"; `MathML, "mo"; `MathML, "mn"; `MathML, "ms"; + `MathML, "mtext"] + + let is_html_integration_point namespace tag_name attributes = + match namespace with + | `HTML | `Other _ -> false + | `MathML -> + tag_name = "annotation-xml" && + attributes |> List.exists (function + | "encoding", "text/html" -> true + | "encoding", "application/xhtml+xml" -> true + | _ -> false) + | `SVG -> + list_mem_string tag_name ["foreignObject"; "desc"; "title"] + + let adjust_mathml_attributes attributes = + attributes |> List.map (fun ((ns, name), value) -> + let name = + if ns = mathml_ns && name = "definitionurl" then "definitionURL" + else name + in + (ns, name), value) + + let adjust_svg_attributes attributes = + attributes |> List.map (fun ((ns, name), value) -> + let name = + match name with + | "attributename" -> "attributeName" + | "attributetype" -> "attributeType" + | "basefrequency" -> "baseFrequency" + | "baseprofile" -> "baseProfile" + | "calcmode" -> "calcMode" + | "clippathunits" -> "clipPathUnits" + | "contentscripttype" -> "contentScriptType" + | "contentstyletype" -> "contentStyleType" + | "diffuseconstant" -> "diffuseConstant" + | "edgemode" -> "edgeMode" + | "externalresourcesrequired" -> "externalResourcesRequired" + | "filterres" -> "filterRes" + | "filterunits" -> "filterUnits" + | "glyphref" -> "glyphRef" + | "gradienttransform" -> "gradientTransform" + | "gradientunits" -> "gradientUnits" + | "kernelmatrix" -> "kernelMatrix" + | "kernelunitlength" -> "kernelUnitLength" + | "keypoints" -> "keyPoints" + | "keysplines" -> "keySplines" + | "keytimes" -> "keyTimes" + | "lengthadjust" -> "lengthAdjust" + | "limitingconeangle" -> "limitingConeAngle" + | "markerheight" -> "markerHeight" + | "markerunits" -> "markerUnits" + | "markerwidth" -> "markerWidth" + | "maskcontentunits" -> "maskContentUnits" + | "maskunits" -> "maskUnits" + | "numoctaves" -> "numOctaves" + | "pathlength" -> "pathLength" + | "patterncontentunits" -> "patternContentUnits" + | "patterntransform" -> "patternTransform" + | "patternunits" -> "patternUnits" + | "pointsatx" -> "pointsAtX" + | "pointsaty" -> "pointsAtY" + | "pointsatz" -> "pointsAtZ" + | "preservealpha" -> "preserveAlpha" + | "preserveaspectratio" -> "preserveAspectRatio" + | "primitiveunits" -> "primitiveUnits" + | "refx" -> "refX" + | "refy" -> "refY" + | "repeatcount" -> "repeatCount" + | "repeatdur" -> "repeatDur" + | "requiredextensions" -> "requiredExtensions" + | "requiredfeatures" -> "requiredFeatures" + | "specularconstant" -> "specularConstant" + | "specularexponent" -> "specularExponent" + | "spreadmethod" -> "spreadMethod" + | "startoffset" -> "startOffset" + | "stddeviation" -> "stdDeviation" + | "stitchtiles" -> "stitchTiles" + | "surfacescale" -> "surfaceScale" + | "systemlanguage" -> "systemLanguage" + | "tablevalues" -> "tableValues" + | "targetx" -> "targetX" + | "targety" -> "targetY" + | "textlength" -> "textLength" + | "viewbox" -> "viewBox" + | "viewtarget" -> "viewTarget" + | "xchannelselector" -> "xChannelSelector" + | "ychannelselector" -> "yChannelSelector" + | "zoomandpan" -> "zoomAndPan" + | _ -> name + in + (ns, name), value) + + let adjust_svg_tag_name = function + | "altglyph" -> "altGlyph" + | "altglyphdef" -> "altGlyphDef" + | "altglyphitem" -> "altGlyphItem" + | "animatecolor" -> "animateColor" + | "animatemotion" -> "animateMotion" + | "animatetransform" -> "animateTransform" + | "clippath" -> "clipPath" + | "feblend" -> "feBlend" + | "fecolormatrix" -> "feColorMatrix" + | "fecomponenttransfer" -> "feComponentTransfer" + | "fecomposite" -> "feComposite" + | "feconvolvematrix" -> "feConvolveMatrix" + | "fediffuselighting" -> "feDiffuseLighting" + | "fedisplacementmap" -> "feDisplacementMap" + | "fedistantlight" -> "feDistantLight" + | "fedropshadow" -> "feDropShadow" + | "feflood" -> "feFlood" + | "fefunca" -> "feFuncA" + | "fefuncb" -> "feFuncB" + | "fefuncg" -> "feFuncG" + | "fefuncr" -> "feFuncR" + | "fegaussianblur" -> "feGaussianBlur" + | "feimage" -> "feImage" + | "femerge" -> "feMerge" + | "femergenode" -> "feMergeNode" + | "femorphology" -> "feMorphology" + | "feoffset" -> "feOffset" + | "fepointlight" -> "fePointLight" + | "fespecularlighting" -> "feSpecularLighting" + | "fespotlight" -> "feSpotLight" + | "fetile" -> "feTile" + | "feturbulence" -> "feTurbulence" + | "foreignobject" -> "foreignObject" + | "glyphref" -> "glyphRef" + | "lineargradient" -> "linearGradient" + | "radialgradient" -> "radialGradient" + | "textpath" -> "textPath" + | s -> s +end + + + +(* Stack of open elements. *) +module Stack : +sig + type t = (element list ref * int) + + val create : ?limit:int -> unit -> t + val elements : t -> element list ref + + val current_element : t -> element option + val require_current_element : t -> element + val adjusted_current_element : Context.t -> t -> element option + val current_element_is : t -> string list -> bool + val current_element_is_foreign : Context.t -> t -> bool + + val has : t -> string -> bool + + val in_scope : t -> string -> bool + val in_button_scope : t -> string -> bool + val in_list_item_scope : t -> string -> bool + val in_table_scope : t -> string -> bool + val in_select_scope : t -> string -> bool + val one_in_scope : t -> string list -> bool + val one_in_table_scope : t -> string list -> bool + val target_in_scope : t -> element -> bool + + val remove : t -> element -> unit + val replace : t -> old:element -> new_:element -> unit + val insert_below : t -> anchor:element -> new_:element -> unit +end = +struct + type t = (element list ref * int) + (** The Adoption Agency algorithm sometimes push too many elements when trying to recover + from malformed HTMLs. Most of the time such HTML *) + + let create ?(limit=Int.max_int) () = (ref [], limit) + let elements (el, _) = el + + let current_element (open_elements, _) = + match !open_elements with + | [] -> None + | element::_ -> Some element + + let require_current_element t = + match current_element t with + | None -> failwith "require_current_element: None" + | Some element -> element + + let adjusted_current_element context (open_elements, _) = + match !open_elements, Context.element context with + | [_], Some element -> Some element + | [], _ -> None + | element::_, _ -> Some element + + let current_element_is (open_elements, _) names = + match !open_elements with + | {element_name = `HTML, name}::_ -> list_mem_string name names + | _ -> false + + let current_element_is_foreign context t = + match adjusted_current_element context t with + | Some {element_name = ns, _} when ns <> `HTML -> true + | _ -> false + + let has (open_elements, _) name = + List.exists + (fun {element_name = ns, name'} -> + ns = `HTML && name' = name) !open_elements + + let in_scope_general scope_delimiters (open_elements, depth_limit) name' = + let rec scan depth = function + | [] -> false + | _ when depth = 0 -> failwith "in_scope_general: depth limit reached" + | {element_name = ns, name'' as name}::more -> + if ns = `HTML && name'' = name' then true + else + if list_mem_qname name scope_delimiters then false + else scan (depth-1) more + in + scan depth_limit !open_elements + + let scope_delimiters = + [`HTML, "applet"; `HTML, "caption"; `HTML, "html"; + `HTML, "table"; `HTML, "td"; `HTML, "th"; + `HTML, "marquee"; `HTML, "object"; `HTML, "template"; + `MathML, "mi"; `MathML, "mo"; `MathML, "mn"; + `MathML, "ms"; `MathML, "mtext"; `MathML, "annotation-xml"; + `SVG, "foreignObject"; `SVG, "desc"; `SVG, "title"] + + let in_scope = in_scope_general scope_delimiters + + let in_button_scope = in_scope_general ((`HTML, "button")::scope_delimiters) + + let in_list_item_scope = + in_scope_general ((`HTML, "ol")::(`HTML, "ul")::scope_delimiters) + + let in_table_scope = + in_scope_general [`HTML, "html"; `HTML, "table"; `HTML, "template"] + + let in_select_scope (open_elements, depth_limit) name = + let rec scan depth = function + | [] -> false + | _ when depth = 0 -> failwith "in_select_scope: depth limit reached" + | {element_name = ns, name'}::more -> + if ns <> `HTML then false + else + if name' = name then true + else + if name' = "optgroup" || name' = "option" then scan (depth-1) more + else false + in + scan depth_limit !open_elements + + let one_in_scope (open_elements, depth_limit) names = + let rec scan depth = function + | [] -> false + | _ when depth = 0 -> failwith "one_in_scope: depth limit reached" + | {element_name = ns, name' as name}::more -> + if ns = `HTML && list_mem_string name' names then true + else + if list_mem_qname name scope_delimiters then false + else scan (depth-1) more + in + scan depth_limit !open_elements + + let one_in_table_scope (open_elements, depth_limit) names = + let rec scan depth = function + | [] -> false + | _ when depth = 0 -> failwith "one_in_table_scope: depth limit reached" + | {element_name = ns, name' as name}::more -> + if ns = `HTML && list_mem_string name' names then true + else + if list_mem_qname name + [`HTML, "html"; `HTML, "table"; `HTML, "template"] then + false + else scan (depth-1) more + in + scan depth_limit !open_elements + + let target_in_scope (open_elements, depth_limit) node = + let rec scan depth = function + | [] -> false + | _ when depth = 0 -> failwith "target_in_scope: depth limit reached" + | e::more -> + if e == node then true + else + if list_mem_qname node.element_name scope_delimiters then false + else scan (depth-1) more + in + scan depth_limit !open_elements + + let remove (open_elements, _) element = + open_elements := List.filter ((!=) element) !open_elements; + element.is_open <- false + + let replace (open_elements, _) ~old ~new_ = + open_elements := + List.map (fun e -> + if e == old then (e.is_open <- false; new_) else e) !open_elements + + let insert_below (open_elements, _) ~anchor ~new_ = + let rec insert prefix = function + | [] -> List.rev prefix + | e::more when e == anchor -> List.rev_append prefix @@ new_::e::more + | e::more -> insert (e::prefix) more + in + open_elements := insert [] !open_elements +end + + + +(* List of active formatting elements. *) +module Active : +sig + type entry = + | Marker + | Element_ of element * location * Token_tag.t + + type t = entry list ref + + val create : unit -> t + + val add_marker : t -> unit + val clear_until_marker : t -> unit + + val has : t -> element -> bool + val remove : t -> element -> unit + val replace : t -> old:element -> new_:element -> unit + val insert_after : t -> anchor:element -> new_:element -> unit + + val has_before_marker : t -> string -> element option +end = +struct + type entry = + | Marker + | Element_ of element * location * Token_tag.t + + type t = entry list ref + + let create () = ref [] + + let add_marker active_formatting_elements = + active_formatting_elements := Marker::!active_formatting_elements + + let clear_until_marker active_formatting_elements = + let rec iterate = function + | Marker::rest -> rest + | (Element_ _)::rest -> iterate rest + | [] -> [] + in + active_formatting_elements := iterate !active_formatting_elements + + let has active_formatting_elements element = + !active_formatting_elements |> List.exists (function + | Element_ (e, _, _) when e == element -> true + | _ -> false) + + let remove active_formatting_elements element = + active_formatting_elements := + !active_formatting_elements |> List.filter (function + | Element_ (e, _, _) when e == element -> false + | _ -> true) + + let replace active_formatting_elements ~old ~new_ = + active_formatting_elements := + !active_formatting_elements |> List.map (function + | Element_ (e, l, t) when e == old -> Element_ (new_, l, t) + | e -> e) + + let insert_after active_formatting_elements ~anchor ~new_ = + let rec insert prefix = function + | [] -> List.rev prefix + | (Element_ (e, l, t) as v)::more when e == anchor -> + let new_entry = Element_ (new_, l, t) in + List.rev_append prefix (v::new_entry::more) + | v::more -> insert (v::prefix) more + in + active_formatting_elements := insert [] !active_formatting_elements + + let has_before_marker active_formatting_elements name = + let rec scan = function + | [] | Marker::_ -> None + | Element_ (n, _, _)::_ when n.element_name = (`HTML, name) -> Some n + | _::more -> scan more + in + scan !active_formatting_elements +end + + + +type mode = unit -> unit + +(* Stack of template insertion modes. *) +module Template : +sig + type t = mode list ref + + val create : unit -> t + + val push : t -> mode -> unit + val pop : t -> unit +end = +struct + type t = (unit -> unit) list ref + + let create () = ref [] + + let push template_insertion_modes mode = + template_insertion_modes := mode::!template_insertion_modes + + let pop template_insertion_modes = + match !template_insertion_modes with + | [] -> () + | _::rest -> template_insertion_modes := rest +end + + + +(* Subtree buffers. HTML specifies the "adoption agency algorithm" for + recovering from certain kinds of errors. This algorithm is (apparently) + incompatible with streaming parsers that do not maintain a DOM - such as + Markup.ml. So, when the Markup.ml parser encounters a situation in which it + may be necessary to later run the adoption agency algorithm, it buffers its + signal output. Instead of being emitted, the signals are used to construct a + DOM subtree. If the algorithm is run, it is run on this subtree. Whenever the + parser can "prove" that the subtree can no longer be involved in the adoption + agency algorithm, it serializes the subtree into the signal stream. In + practice, this means that buffering begins when a formatting element is + encountered, and ends when the parent of the formatting element is popped off + the open element stack. *) +module Subtree : +sig + type t + + val create : Stack.t -> t + + val accumulate : t -> location -> signal -> bool + + val enable : t -> unit + val disable : t -> (location * signal) list + + val adoption_agency_algorithm : + t -> Active.t -> location -> string -> bool * (location * Error.t) list +end = +struct + type t = + {open_elements : Stack.t; + mutable enabled : bool; + mutable position : element} + + let create open_elements = + {open_elements; + enabled = false; + position = Element.dummy} + + let accumulate subtree_buffer l s = + if not subtree_buffer.enabled then true + else begin + begin match s with + | `Start_element (_, attributes) -> + let parent = subtree_buffer.position in + let child = + Stack.require_current_element subtree_buffer.open_elements in + + child.attributes <- attributes; + child.parent <- parent; + parent.children <- (l, Element child)::parent.children; + + subtree_buffer.position <- child + + | `End_element -> + subtree_buffer.position.end_location <- l; + subtree_buffer.position <- + Stack.require_current_element subtree_buffer.open_elements + + | `Text ss -> + subtree_buffer.position.children <- + (l, Text ss)::subtree_buffer.position.children + + | `PI (t, s) -> + subtree_buffer.position.children <- + (l, PI (t, s))::subtree_buffer.position.children + + | `Comment s -> + subtree_buffer.position.children <- + (l, Comment s)::subtree_buffer.position.children + + | `Xml _ | `Doctype _ -> () + end; + + false + end + + let enable subtree_buffer = + if subtree_buffer.enabled then () + else + match Stack.current_element subtree_buffer.open_elements with + | None -> () + | Some element -> + element.buffering <- true; + subtree_buffer.position <- element; + subtree_buffer.enabled <- true + + let disable subtree_buffer = + let (_, depth_limit) = subtree_buffer.open_elements in + let rec traverse depth acc = function + | _ when depth = 0 -> failwith "Subtree.disable: depth limit reached" + | l, Element {element_name; attributes; end_location; children} -> + let name = Ns.to_string (fst element_name), snd element_name in + let start_signal = l, `Start_element (name, attributes) in + let end_signal = end_location, `End_element in + start_signal::(List.fold_left (traverse (depth-1)) (end_signal::acc) children) + + | l, Text ss -> + begin match acc with + | (_, `Text ss')::rest -> (l, `Text (ss @ ss'))::rest + | _ -> (l, `Text ss)::acc + end + + | l, PI (t, s) -> (l, `PI (t, s))::acc + | l, Comment s -> (l, `Comment s)::acc + in + + let result = + List.fold_left (traverse depth_limit) [] + (Stack.require_current_element subtree_buffer.open_elements).children + in + + subtree_buffer.enabled <- false; + + result + + (* Part of 8.2.5.4.7. *) + let adoption_agency_algorithm + subtree_buffer active_formatting_elements l subject = + + let (open_elements, _) as stack = subtree_buffer.open_elements in + + let above_removed_nodes = ref [] in + + let rec above_in_stack node = function + | e::e'::_ when e == node -> e' + | _::more -> above_in_stack node more + | [] -> failwith "above_in_stack: not found" + in + + let above_node node = + if node.is_open then above_in_stack node !open_elements + else + try List.find (fun (e, _) -> e == node) !above_removed_nodes |> snd + with Not_found -> failwith "above_node: not found" + in + + let remove_node node = + above_removed_nodes := + (node, above_in_stack node !open_elements)::!above_removed_nodes; + Stack.remove stack node + in + + let reparent node new_parent = + let old_parent = node.parent in + + let entry, filtered_children = + let rec remove prefix = function + | (_, Element e as entry)::rest when e == node -> + entry, List.rev_append prefix rest + | e::rest -> remove (e::prefix) rest + | [] -> (node.location, Element node), old_parent.children + in + remove [] old_parent.children + in + + old_parent.children <- filtered_children; + new_parent.children <- entry::new_parent.children; + node.parent <- new_parent + in + + let inner_loop formatting_element furthest_block = + let rec repeat inner_loop_counter node last_node bookmark = + let node = above_node node in + + if node == formatting_element then last_node, bookmark + else begin + if inner_loop_counter > 3 then + Active.remove active_formatting_elements node; + + if not @@ Active.has active_formatting_elements node then begin + remove_node node; + repeat (inner_loop_counter + 1) node last_node bookmark + end + else begin + let new_node = + {node with is_open = true; children = []; parent = Element.dummy} + in + + node.end_location <- l; + + Stack.replace stack ~old:node ~new_:new_node; + Active.replace active_formatting_elements ~old:node ~new_:new_node; + + reparent last_node new_node; + + repeat (inner_loop_counter + 1) new_node new_node + (if last_node == furthest_block then Some new_node else bookmark) + end + end + + in + repeat 1 furthest_block furthest_block None + in + + let find_formatting_element () = + let rec scan = function + | [] -> None + | Active.Marker::_ -> None + | (Active.Element_ ({element_name = `HTML, n} as e, _, _))::_ + when n = subject -> Some e + | _::rest -> scan rest + in + scan !active_formatting_elements + in + + let find_furthest_block formatting_element = + let rec scan furthest = function + | [] -> furthest + | e::_ when e == formatting_element -> furthest + | e::more when Element.is_special e.element_name -> scan (Some e) more + | _::more -> scan furthest more + in + scan None !open_elements + in + + let pop_to_formatting_element formatting_element = + let rec pop () = + match !open_elements with + | [] -> () + | e::more -> + open_elements := more; + e.is_open <- false; + e.end_location <- l; + if e != formatting_element then pop () + in + pop (); + subtree_buffer.position <- Stack.require_current_element stack + in + + let rec outer_loop outer_loop_counter errors = + let outer_loop_counter = outer_loop_counter + 1 in + + if outer_loop_counter >= 8 then true, List.rev errors + else begin + match find_formatting_element () with + | None -> false, List.rev errors + | Some formatting_element -> + if not formatting_element.is_open then begin + Active.remove active_formatting_elements formatting_element; + true, List.rev ((l, `Unmatched_end_tag subject)::errors) + end + else begin + if not @@ Stack.target_in_scope stack + formatting_element then begin + true, List.rev ((l, `Unmatched_end_tag subject)::errors) + end + else begin + let errors = + if Stack.require_current_element stack == + formatting_element then + errors + else (l, `Unmatched_end_tag subject)::errors + in + + match find_furthest_block formatting_element with + | None -> + pop_to_formatting_element formatting_element; + Active.remove active_formatting_elements formatting_element; + true, List.rev errors + + | Some furthest_block -> + formatting_element.end_location <- l; + + let common_ancestor = + above_in_stack formatting_element !open_elements in + + let last_node, bookmark = + inner_loop formatting_element furthest_block in + + reparent last_node common_ancestor; + + let new_node = + {formatting_element with + is_open = true; children = []; parent = Element.dummy} + in + + new_node.children <- furthest_block.children; + furthest_block.children <- []; + new_node.children |> List.iter (function + | _, Element child -> child.parent <- new_node + | _ -> ()); + + reparent new_node furthest_block; + + begin match bookmark with + | None -> + Active.replace active_formatting_elements + ~old:formatting_element ~new_:new_node + | Some node -> + Active.remove active_formatting_elements formatting_element; + Active.insert_after + active_formatting_elements ~anchor:node ~new_:new_node + end; + + Stack.remove stack formatting_element; + Stack.insert_below + stack ~anchor:furthest_block ~new_:new_node; + + outer_loop outer_loop_counter errors + end + end + end + in + + let current_node = Stack.require_current_element stack in + if current_node.element_name = (`HTML, subject) then begin + open_elements := List.tl !open_elements; + current_node.is_open <- false; + current_node.end_location <- l; + subtree_buffer.position <- Stack.require_current_element stack; + Active.remove active_formatting_elements current_node; + true, [] + end + else outer_loop 0 [] +end + + + +let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, set_foreign) = + let context = Context.uninitialized () in + + let throw = ref (fun _ -> ()) in + let ended = ref (fun _ -> ()) in + let output = ref (fun _ -> ()) in + + let report_if = Error.report_if report in + let unmatched_end_tag l name k = + report l (`Unmatched_end_tag name) !throw k in + let misnested_tag l t context_name k = + report l (`Misnested_tag (t.name, context_name, t.Token_tag.attributes)) !throw k in + + let open_elements = Stack.create ?limit:depth_limit () in + let active_formatting_elements = Active.create () in + let subtree_buffer = Subtree.create open_elements in + let text = Text.prepare () in + let template_insertion_modes = Template.create () in + let frameset_ok = ref true in + let head_seen = ref false in + let form_element_pointer = ref None in + + let add_character = Text.add text in + let add_string = Text.add_string text in + + set_foreign (fun () -> + Stack.current_element_is_foreign context open_elements); + + let report_if_stack_has_other_than names k = + let rec iterate = function + | [] -> k () + | {element_name = ns, name; location}::more -> + report_if (not (ns = `HTML && list_mem_string name names)) + location (fun () -> `Unmatched_start_tag name) !throw (fun () -> + iterate more) + in + iterate !(Stack.elements open_elements) + in + + let rec current_mode = ref initial_mode + + and constructor throw_ k = + Context.initialize tokens requested_context context throw_ (fun () -> + + let initial_tokenizer_state = + match Context.the_context context with + | `Fragment (`HTML, ("title" | "textarea")) -> `RCDATA + | `Fragment + (`HTML, ("style" | "xmp" | "iframe" | "noembed" | "noframes")) -> + `RAWTEXT + | `Fragment (`HTML, "script") -> `Script_data + | `Fragment (`HTML, "plaintext") -> `PLAINTEXT + | _ -> `Data + in + + set_tokenizer_state initial_tokenizer_state; + + begin match Context.the_context context with + | `Document -> () + | `Fragment _ -> + let notional_root = + Element.create ~suppress:true (`HTML, "html") (1, 1) in + (Stack.elements open_elements) := [notional_root] + end; + + begin match Context.the_context context with + | `Fragment (`HTML, "template") -> + Template.push template_insertion_modes in_template_mode + | _ -> () + end; + + (* The following is a deviation from conformance. The goal is to avoid + insertion of a element into a fragment beginning with a or + element. *) + begin match Context.token context with + | Some ("body" | "frameset") -> head_seen := true + | _ -> () + end; + + current_mode := + begin match Context.the_context context with + | `Fragment _ -> reset_mode () + | `Document -> initial_mode + end; + + (fun throw_ e k -> + throw := throw_; + ended := e; + output := k; + !current_mode ()) + |> make + |> k) + + (* 8.2.3.1. *) + and reset_mode () = + let rec iterate last = function + | [e] when not last && Context.the_context context <> `Document -> + begin match Context.the_context context with + | `Document -> assert false + | `Fragment name -> iterate true [{e with element_name = name}] + end + | {element_name = _, "select"}::ancestors -> + let rec iterate' = function + | [] -> in_select_mode + | {element_name = _, "template"}::_ -> in_select_mode + | {element_name = _, "table"}::_ -> in_select_in_table_mode + | _::ancestors -> iterate' ancestors + in + iterate' ancestors + | {element_name = _, ("tr" | "th")}::_::_ -> in_cell_mode + | {element_name = _, "tr"}::_ -> in_row_mode + | {element_name = _, ("tbody" | "thead" | "tfoot")}::_ -> + in_table_body_mode + | {element_name = _, "caption"}::_ -> in_caption_mode + | {element_name = _, "colgroup"}::_ -> in_column_group_mode + | {element_name = _, "table"}::_ -> in_table_mode + | {element_name = _, "template"}::_ -> + begin match !template_insertion_modes with + | [] -> initial_mode (* This is an internal error, actually. *) + | mode::_ -> mode + end + (* The next case corresponds to item 12 of "Resetting the insertion mode + appropriately." It is commented out as deliberate deviation from the + specification, because that makes parsing of fragments intended for + elements more intuitive. For conformance, the pattern in the + following case would have to end with ::_::_, not ::_. *) + (* | [{element_name = _, "head"}] -> in_body_mode *) + | {element_name = _, "head"}::_ -> in_head_mode + | {element_name = _, "body"}::_ -> in_body_mode + | {element_name = _, "frameset"}::_ -> in_frameset_mode + | {element_name = _, "html"}::_ -> + if !head_seen then after_head_mode else before_head_mode + | _::rest -> iterate last rest + | [] -> in_body_mode + in + iterate false !(Stack.elements open_elements) + + and emit' l s m = + if Subtree.accumulate subtree_buffer l s then begin + current_mode := m; + !output (l, s) + end + else m () + + and emit_list ss m = + match ss with + | [] -> m () + | (l, s)::more -> emit' l s (fun () -> emit_list more m) + + and emit_text m = + match Text.emit text with + | None -> m () + | Some (l', strings) -> + emit' l' (`Text strings) m + + and emit l s m = emit_text (fun () -> emit' l s m) + + and push_and_emit + ?(formatting = false) ?(acknowledge = false) ?(namespace = `HTML) + ?(set_form_element_pointer = false) location + ({Token_tag.name; attributes; self_closing} as tag) mode = + + report_if (self_closing && not acknowledge) location (fun () -> + `Bad_token ("/>", "tag", "should not be self-closing")) + !throw (fun () -> + + let namespace_string = Ns.to_string namespace in + + let tag_name = + match namespace with + | `SVG -> Foreign.adjust_svg_tag_name name + | _ -> name + in + + let is_html_integration_point = + Foreign.is_html_integration_point namespace tag_name attributes in + + let attributes = + List.map (fun (n, v) -> Namespace.Parsing.parse n, v) attributes in + let attributes = + match namespace with + | `HTML | `Other _ -> attributes + | `MathML -> Foreign.adjust_mathml_attributes attributes + | `SVG -> Foreign.adjust_svg_attributes attributes + in + + let element_entry = + Element.create ~is_html_integration_point (namespace, name) location + in + let elements_ref = Stack.elements open_elements in + elements_ref := element_entry::!elements_ref; + + if set_form_element_pointer then + form_element_pointer := Some element_entry; + + if formatting then + active_formatting_elements := + Active.Element_ (element_entry, location, tag):: + !active_formatting_elements; + + emit location + (`Start_element ((namespace_string, tag_name), attributes)) mode) + + and push_implicit location name mode = + push_and_emit location + {Token_tag.name = name; attributes = []; self_closing = false} mode + + and pop location mode = + match !(Stack.elements open_elements) with + | [] -> mode () + | element::more -> + emit_text (fun () -> + (fun k -> + if not element.buffering then k () + else emit_list (Subtree.disable subtree_buffer) k) + (fun () -> + (Stack.elements open_elements) := more; + element.is_open <- false; + if element.suppress then mode () + else emit' location `End_element mode)) + + and pop_until condition location mode = + let rec iterate () = + match !(Stack.elements open_elements) with + | [] -> mode () + | element::_ -> + if condition element then mode () + else pop location iterate + in + iterate () + + and close_element ?(ns = `HTML) l name mode = + pop_until + (fun {element_name = ns', name'} -> ns' = ns && name' = name) l + (fun () -> + pop l mode) + + and pop_until_and_raise_errors names location mode = + let rec iterate () = + match !(Stack.elements open_elements) with + | [] -> mode () + | {element_name = ns, name}::_ -> + if ns = `HTML && list_mem_string name names then pop location mode + else + report location (`Unmatched_start_tag name) !throw (fun () -> + pop location iterate) + in + iterate () + + and pop_implied ?(except = "") location mode = + pop_until (fun {element_name = _, name} -> + name = except || + not @@ list_mem_string name + ["dd"; "dt"; "li"; "option"; "optgroup"; "p"; "rb"; "rp"; "rt"; + "rtc"]) location mode + + and pop_to_table_context location mode = + pop_until (function + | {element_name = `HTML, ("table" | "template" | "html")} -> true + | _ -> false) location mode + + and pop_to_table_body_context location mode = + pop_until (function + | {element_name = + `HTML, ("tbody" | "thead" | "tfoot" | "template" | "html")} -> true + | _ -> false) location mode + + and pop_to_table_row_context location mode = + pop_until (function + | {element_name = `HTML, ("tr" | "template" | "html")} -> true + | _ -> false) location mode + + and close_element_with_implied name location mode = + pop_implied ~except:name location (fun () -> + let check_element k = + match Stack.current_element open_elements with + | Some {element_name = `HTML, name'} when name' = name -> k () + | Some {element_name = _, name; location} -> + report location (`Unmatched_start_tag name) !throw k + | None -> + unmatched_end_tag location name k + in + check_element (fun () -> + close_element location name mode)) + + and close_cell location mode = + pop_implied location (fun () -> + (fun mode -> + match Stack.current_element open_elements with + | Some {element_name = `HTML, ("td" | "th")} -> mode () + | Some {element_name = _, name} -> + unmatched_end_tag location name mode + | None -> + unmatched_end_tag location "" mode) + @@ (fun () -> + pop_until (function + | {element_name = `HTML, ("td" | "th")} -> true + | _ -> false) location (fun () -> + pop location mode))) + + and close_current_p_element l mode = + if Stack.in_button_scope open_elements "p" then + close_element_with_implied "p" l mode + else mode () + + and close_preceding_tag names l mode = + let rec scan = function + | [] -> mode () + | {element_name = (ns, name) as name'}::more -> + if ns = `HTML && list_mem_string name names then + close_element_with_implied name l mode + else + if Element.is_special name' && + not @@ list_mem_qname name' + [`HTML, "address"; `HTML, "div"; `HTML, "p"] then + mode () + else + scan more + in + scan !(Stack.elements open_elements) + + and emit_end l = + pop_until (fun _ -> false) l (fun () -> + emit_text (fun () -> + !ended ())) + + and reconstruct_active_formatting_elements mode = + let rec get_prefix prefix = function + | [] -> prefix, [] + | Active.Marker::_ as l -> prefix, l + | Active.Element_ ({is_open = true}, _, _)::_ as l -> prefix, l + | Active.Element_ ({is_open = false}, l, tag)::more -> + get_prefix ((l, tag)::prefix) more + in + let to_reopen, remainder = get_prefix [] !active_formatting_elements in + active_formatting_elements := remainder; + + begin match to_reopen with + | [] -> () + | _::_ -> Subtree.enable subtree_buffer + end; + + let rec reopen = function + | [] -> mode () + | (l, tag)::more -> + push_and_emit ~formatting:true l tag (fun () -> reopen more) + in + reopen to_reopen + + (* 8.2.5. *) + and dispatch tokens rules = + next tokens !throw (fun () -> !ended ()) begin fun ((_, t) as v) -> + let foreign = + match Stack.adjusted_current_element context open_elements, t with + | None, _ -> false + | Some {element_name = `HTML, _}, _ -> false + | Some {element_name}, `Start {name} + when Foreign.is_mathml_text_integration_point element_name + && name <> "mglyph" && name <> "malignmark" -> false + | Some {element_name = `MathML, "annotation-xml"}, + `Start {name = "svg"} -> false + | Some {is_html_integration_point = true}, `Start _ -> false + | Some {is_html_integration_point = true}, `Char _ -> false + | Some {is_html_integration_point = true}, `String _ -> false + | _, `EOF -> false + | _ -> true + in + + if not foreign then rules v + else foreign_content !current_mode (fun () -> rules v) v + end + + (* 8.2.5.4.1. *) + and initial_mode () = + dispatch tokens begin function + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> + initial_mode () + + | _, `String s when is_whitespace_only s -> + initial_mode () + + | l, `Comment s -> + emit l (`Comment s) initial_mode + + | l, `Doctype d -> + emit l (`Doctype d) before_html_mode + + | v -> + push tokens v; + before_html_mode () + end + + (* 8.2.5.4.2. *) + and before_html_mode () = + dispatch tokens begin function + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + before_html_mode + + | l, `Comment s -> + emit l (`Comment s) before_html_mode + + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> + before_html_mode () + + | _, `String s when is_whitespace_only s -> + before_html_mode () + + | l, `Start ({name = "html"} as t) -> + push_and_emit l t before_head_mode + + | l, `End {name} + when not @@ list_mem_string name ["head"; "body"; "html"; "br"] -> + unmatched_end_tag l name before_html_mode + + | l, _ as v -> + push tokens v; + push_implicit l "html" before_head_mode + end + + (* 8.2.5.4.3. *) + and before_head_mode () = + dispatch tokens begin function + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> + before_head_mode () + + | _, `String s when is_whitespace_only s -> + before_head_mode () + + | l, `Comment s -> + emit l (`Comment s) before_head_mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + before_head_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "html" before_head_mode v + + | l, `Start ({name = "head"} as t) -> + head_seen := true; + push_and_emit l t in_head_mode + + | l, `End {name} + when not @@ list_mem_string name ["head"; "body"; "html"; "br"] -> + report l (`Unmatched_end_tag name) !throw before_head_mode + + | l, _ as v -> + head_seen := true; + push tokens v; + push_implicit l "head" in_head_mode + end + + (* 8.2.5.4.4. *) + and in_head_mode () = + dispatch tokens (fun v -> in_head_mode_rules in_head_mode v) + + (* 8.2.5.4.4. *) + and in_head_mode_rules mode = function + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + add_character l c; + mode () + + | l, `String s when is_whitespace_only s -> + add_string l s; + mode () + + | l, `Comment s -> + emit l (`Comment s) mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "head" in_head_mode v + + | l, `Start ({name = + "base" | "basefont" | "bgsound" | "link" | "meta"} as t) -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l mode) + + | l, `Start ({name = "title"} as t) -> + push_and_emit l t (fun () -> + parse_rcdata mode) + + | l, `Start ({name = "noframes" | "style"} as t) -> + push_and_emit l t (fun () -> + parse_rawtext mode) + + | l, `Start ({name = "noscript"} as t) -> + push_and_emit l t in_head_noscript_mode + + | l, `Start ({name = "script"} as t) -> + push_and_emit l t (fun () -> + set_tokenizer_state `Script_data; + text_mode mode) + + | l, `End {name = "head"} -> + pop l after_head_mode + + | l, `Start ({name = "template"} as t) -> + Active.add_marker active_formatting_elements; + frameset_ok := false; + Template.push template_insertion_modes in_template_mode; + push_and_emit l t in_template_mode + + | l, `End {name = "template"} -> + if not @@ Stack.has open_elements "template" then + report l (`Unmatched_end_tag "template") !throw mode + else begin + Active.clear_until_marker active_formatting_elements; + Template.pop template_insertion_modes; + close_element_with_implied "template" l (fun () -> reset_mode () ()) + end + + | l, `Start ({name = "head"} as t) -> + misnested_tag l t "head" mode + + | l, `End {name} when not @@ list_mem_string name ["body"; "html"; "br"] -> + report l (`Unmatched_end_tag name) !throw mode + + | l, _ as v -> + push tokens v; + pop l after_head_mode + + (* 8.2.5.4.5. *) + and in_head_noscript_mode () = + dispatch tokens begin function + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + in_head_noscript_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "noscript" in_head_noscript_mode v + + | l, `End {name = "noscript"} -> + pop l in_head_mode + + | _, `String s as v when is_whitespace_only s -> + in_head_mode_rules in_head_noscript_mode v + + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) + | _, `Comment _ + | _, `Start {name = + "basefont" | "bgsound" | "link" | "meta" | "noframes" | + "style"} as v -> + in_head_mode_rules in_head_noscript_mode v + + | l, `Start ({name = "head" | "noscript"} as t) -> + misnested_tag l t "noscript" in_head_noscript_mode + + | l, `End {name} when name <> "br" -> + report l (`Unmatched_end_tag name) !throw in_head_noscript_mode + + | l, _ as v -> + report l (`Bad_content "noscript") !throw (fun () -> + push tokens v; + pop l in_head_mode) + end + + (* 8.2.5.4.6. *) + and after_head_mode () = + dispatch tokens begin function + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + add_character l c; + after_head_mode () + + | l, `String s when is_whitespace_only s -> + add_string l s; + after_head_mode () + + | l, `Comment s -> + emit l (`Comment s) after_head_mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + after_head_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "html" after_head_mode v + + | l, `Start ({name = "body"} as t) -> + frameset_ok := false; + push_and_emit l t in_body_mode + + | l, `Start ({name = "frameset"} as t) -> + push_and_emit l t in_frameset_mode + + | l, `Start ({name = + "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | + "script" | "style" | "template" | "title"} as t) as v -> + misnested_tag l t "html" (fun () -> + in_head_mode_rules after_head_mode v) + + | _, `End {name = "template"} as v -> + in_head_mode_rules after_head_mode v + + | l, `Start {name = "head"} -> + report l (`Bad_document "duplicate head element") !throw + after_head_mode + + | l, `End {name} + when not @@ list_mem_string name ["body"; "html"; "br"] -> + report l (`Unmatched_end_tag name) !throw after_head_mode + + (* This case is not found in the specification. It is a deliberate + deviation from conformance, so that fragments "..." don't + get an implicit element generated after the element. *) + | l, `EOF + when (Context.the_context context = `Fragment (`HTML, "html") + || Context.the_context context = `Fragment (`HTML, "head")) -> + emit_end l + + | l, _ as t -> + push tokens t; + push_implicit l "body" in_body_mode + end + + (* 8.2.5.4.7. *) + and in_body_mode () = + dispatch tokens (fun v -> in_body_mode_rules "body" in_body_mode v) + + (* 8.2.5.4.7. *) + and in_body_mode_rules context_name mode = function + | l, `Char 0 -> + report l (`Bad_token ("U+0000", "body", "null")) !throw mode + + | l, `String s -> + reconstruct_active_formatting_elements (fun () -> + add_string l s; + if not @@ is_whitespace_only s then frameset_ok := false; + mode ()) + + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + reconstruct_active_formatting_elements (fun () -> + add_character l c; + mode ()) + + | l, `Char c -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + add_character l c; + mode ()) + + | l, `Comment s -> + emit l (`Comment s) mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + + | l, `Start ({name = "html"} as t) -> + misnested_tag l t context_name mode + + | _, `Start {name = + "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | + "script" | "style" | "template" | "title"} + | _, `End {name = "template"} as v -> + in_head_mode_rules mode v + + | l, `Start ({name = "body"} as t) -> + misnested_tag l t context_name mode + + | l, `Start ({name = "frameset"} as t) -> + misnested_tag l t context_name (fun () -> + match !(Stack.elements open_elements) with + | [_] -> mode () + | _ -> + let rec second_is_body = function + | [{element_name = `HTML, "body"}; _] -> true + | [] -> false + | _::more -> second_is_body more + in + if not @@ second_is_body !(Stack.elements open_elements) then mode () + else + if not !frameset_ok then mode () + else + (* There is a deviation here due to the nature of the parser: if a + body element has been emitted, it can't be suppressed. *) + pop_until + (fun _ -> match !(Stack.elements open_elements) with [_] -> true | _ -> false) + l (fun () -> + push_and_emit l t in_frameset_mode)) + + | l, `EOF as v -> + report_if_stack_has_other_than + ["dd"; "dt"; "li"; "p"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr"; + "body"; "html"] (fun () -> + match !template_insertion_modes with + | [] -> emit_end l + | _ -> in_template_mode_rules mode v) + + | l, `End {name = "body"} -> + if not @@ Stack.in_scope open_elements "body" then + report l (`Unmatched_end_tag "body") !throw mode + else + report_if_stack_has_other_than + ["dd"; "dt"; "li"; "optgroup"; "option"; "p"; "rb"; "rp"; "rt"; + "rtc"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr"; "body"; + "html"] (fun () -> + after_body_mode ()) + + | l, `End {name = "html"} as v -> + if not @@ Stack.in_scope open_elements "body" then + report l (`Unmatched_end_tag "html") !throw mode + else + report_if_stack_has_other_than + ["dd"; "dt"; "li"; "optgroup"; "option"; "p"; "rb"; "rp"; "rt"; + "rtc"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr"; "body"; + "html"] (fun () -> + push tokens v; + after_body_mode ()) + + | l, `Start ({name = + "address" | "article" | "aside" | "blockquote" | "center" | + "details" | "dialog" | "dir" | "div" | "dl" | "fieldset" | + "figcaption" | "figure" | "footer" | "header" | "hgroup" | "main" | + "nav" | "ol" | "p" | "section" | "summary" | "ul"} as t) -> + close_current_p_element l (fun () -> + push_and_emit l t mode) + + | l, `Start ({name = + "h1" | "h2" | "h3" | "h4" | "h5" | "h6"} as t) -> + close_current_p_element l (fun () -> + (fun mode' -> + match Stack.current_element open_elements with + | Some {element_name = `HTML, + ("h1" | "h2" | "h3" | "h4" | "h5" | "h6" as name')} -> + misnested_tag l t name' (fun () -> + pop l mode') + | _ -> mode' ()) (fun () -> + push_and_emit l t mode)) + + | l, `Start ({name = "pre" | "listing"} as t) -> + frameset_ok := false; + close_current_p_element l (fun () -> + push_and_emit l t (fun () -> + (* https://html.spec.whatwg.org/multipage/grouping-content.html#the-pre-element *) + (* In the HTML syntax, a leading newline character immediately following the pre element start tag is stripped. *) + next_expected tokens !throw (function + | _, `Char 0x000A -> mode () + | loc, `String s when String.starts_with ~prefix:"\n" s -> push tokens (loc, `String (String.sub s 1 (String.length s - 1))); mode () + | v -> + push tokens v; + mode ()))) + + | l, `Start ({name = "form"} as t) -> + if !form_element_pointer <> None && + not @@ Stack.has open_elements "template" then + misnested_tag l t "form" mode + else begin + close_current_p_element l (fun () -> + let in_template = Stack.has open_elements "template" in + push_and_emit ~set_form_element_pointer:(not in_template) l t mode) + end + + | l, `Start ({name = "li"} as t) -> + frameset_ok := false; + close_preceding_tag ["li"] l (fun () -> + close_current_p_element l (fun () -> + push_and_emit l t mode)) + + | l, `Start ({name = "dd" | "dt"} as t) -> + frameset_ok := false; + close_preceding_tag ["dd"; "dt"] l (fun () -> + close_current_p_element l (fun () -> + push_and_emit l t mode)) + + | l, `Start ({name = "plaintext"} as t) -> + close_current_p_element l (fun () -> + set_tokenizer_state `PLAINTEXT; + push_and_emit l t mode) + + | l, `Start ({name = "button"} as t) -> + (fun mode' -> + if Stack.in_scope open_elements "button" then + misnested_tag l t "button" (fun () -> + close_element_with_implied "button" l mode') + else mode' ()) + (fun () -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t mode)) + + | l, `End {name = + "address" | "article" | "aside" | "blockquote" | "button" | + "center" | "details" | "dialog" | "dir" | "div" | "dl" | "fieldset" | + "figcaption" | "figure" | "footer" | "header" | "hgroup" | "listing" | + "main" | "nav" | "ol" | "pre" | "section" | "summary" | "ul" + as name} -> + if not @@ Stack.in_scope open_elements name then + report l (`Unmatched_end_tag name) !throw mode + else + close_element_with_implied name l mode + + | l, `End {name = "form"} -> + if not @@ Stack.has open_elements "template" then begin + let form_element = !form_element_pointer in + form_element_pointer := None; + match form_element with + | Some element when Stack.target_in_scope open_elements element -> + pop_implied l (fun () -> + match Stack.current_element open_elements with + | Some element' when element' == element -> + pop l mode + | _ -> + report element.location (`Unmatched_start_tag "form") !throw + (fun () -> + pop_until (fun element' -> element' == element) l (fun () -> + pop l mode))) + | _ -> + report l (`Unmatched_end_tag "form") !throw mode + end + else + if not @@ Stack.in_scope open_elements "form" then + report l (`Unmatched_end_tag "form") !throw mode + else + close_element_with_implied "form" l mode + + | l, `End {name = "p"} -> + (fun mode' -> + if not @@ Stack.in_button_scope open_elements "p" then + report l (`Unmatched_end_tag "p") !throw (fun () -> + push_implicit l "p" mode') + else mode' ()) + (fun () -> close_element_with_implied "p" l mode) + + | l, `End {name = "li"} -> + if not @@ Stack.in_list_item_scope open_elements "li" then + report l (`Unmatched_end_tag "li") !throw mode + else + close_element_with_implied "li" l mode + + | l, `End {name = "dd" | "dt" as name} -> + if not @@ Stack.in_scope open_elements name then + report l (`Unmatched_end_tag name) !throw mode + else + close_element_with_implied name l mode + + | l, `End {name = "h1" | "h2" | "h3" | "h4" | "h5" | "h6" as name} -> + if not @@ Stack.one_in_scope open_elements + ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] then + report l (`Unmatched_end_tag name) !throw mode + else + pop_implied l (fun () -> + (fun next -> + match Stack.current_element open_elements with + | Some {element_name = `HTML, name'} + when list_mem_string + name' ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] -> + next () + | _ -> + report l (`Unmatched_end_tag name) !throw next) + @@ (fun () -> + pop_until_and_raise_errors + ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] l mode)) + + | l, `Start ({name = "a"} as t) -> + (fun k -> + match Active.has_before_marker active_formatting_elements "a" with + | None -> k () + | Some existing -> + misnested_tag l t "a" (fun () -> + adoption_agency_algorithm l "a" (fun () -> + Stack.remove open_elements existing; + Active.remove active_formatting_elements existing; + k ()))) + (fun () -> + Subtree.enable subtree_buffer; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~formatting:true l t mode)) + + | l, `Start ({name = + "b" | "big" | "code" | "em" | "font" | "i" | "s" | "small" | + "strike" | "strong" | "tt" | "u"} as t) -> + Subtree.enable subtree_buffer; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~formatting:true l t mode) + + | l, `Start ({name = "nobr"} as t) -> + Subtree.enable subtree_buffer; + reconstruct_active_formatting_elements (fun () -> + (fun k -> + if not @@ Stack.in_scope open_elements "nobr" then k () + else + misnested_tag l t "nobr" (fun () -> + adoption_agency_algorithm l "nobr" (fun () -> + reconstruct_active_formatting_elements k))) + (fun () -> push_and_emit ~formatting:true l t mode)) + + | l, `End {name = + "a" | "b" | "big" | "code" | "em" | "font" | "i" | "nobr" | "s" | + "small" | "strike" | "strong" | "tt" | "u" as name} -> + adoption_agency_algorithm l name mode + + | l, `Start ({name = "applet" | "marquee" | "object"} as t) -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + Active.add_marker active_formatting_elements; + push_and_emit l t mode) + + | l, `End {name = "applet" | "marquee" | "object" as name} -> + if not @@ Stack.in_scope open_elements name then + report l (`Unmatched_end_tag name) !throw mode + else begin + Active.clear_until_marker active_formatting_elements; + close_element_with_implied name l mode + end + + | l, `Start ({name = "table"} as t) -> + frameset_ok := false; + close_current_p_element l (fun () -> + push_and_emit l t in_table_mode) + + | l, `End {name = "br"} -> + report l (`Unmatched_end_tag "br") !throw (fun () -> + in_body_mode_rules context_name mode + (l, `Start + {Token_tag.name = "br"; attributes = []; self_closing = false})) + + | l, `Start ({name = + "area" | "br" | "embed" | "img" | "keygen" | "wbr"} as t) -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l mode)) + + | l, `Start ({name = "input"} as t) -> + if Element.is_not_hidden t then frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l mode)) + + | l, `Start ({name = "param" | "source" | "track"} as t) -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l mode) + + | l, `Start ({name = "hr"} as t) -> + frameset_ok := false; + close_current_p_element l (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l mode)) + + | l, `Start ({name = "image"} as t) -> + report l (`Bad_token ("image", "tag", "should be 'img'")) !throw + (fun () -> + push tokens (l, `Start {t with name = "img"}); + mode ()) + + | l, `Start ({name = "textarea"} as t) -> + frameset_ok := false; + push_and_emit l t (fun () -> + set_tokenizer_state `RCDATA; + next_expected tokens !throw (function + | _, `Char 0x000A -> text_mode mode + | loc, `String s when String.starts_with ~prefix:"\n" s -> push tokens (loc, `String (String.sub s 1 (String.length s - 1))); text_mode mode + | v -> + push tokens v; + text_mode mode)) + + | l, `Start {name = "xmp"} -> + frameset_ok := false; + close_current_p_element l (fun () -> + reconstruct_active_formatting_elements (fun () -> + parse_rawtext mode)) + + | l, `Start ({name = "iframe"} as t) -> + frameset_ok := false; + push_and_emit l t (fun () -> + parse_rawtext mode) + + | l, `Start ({name = "noembed"} as t) -> + push_and_emit l t (fun () -> + parse_rawtext mode) + + | l, `Start ({name = "select"} as t) -> + frameset_ok := false; + select_in_body l t in_select_mode + + | l, `Start ({name = "optgroup" | "option"} as t) -> + (fun mode' -> + if Stack.current_element_is open_elements ["option"] then + pop l mode' + else mode' ()) + (fun () -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t mode)) + + | l, `Start ({name = "rb" | "rtc"} as t) -> + (fun mode' -> + let finish () = + if Stack.current_element_is open_elements ["ruby"] then + mode' () + else + misnested_tag l t context_name mode' + in + if Stack.in_scope open_elements "ruby" then + pop_implied l finish + else + finish ()) + (fun () -> + push_and_emit l t mode) + + | l, `Start ({name = "rp" | "rt"} as t) -> + (fun mode' -> + let finish () = + if Stack.current_element_is open_elements ["ruby"; "rtc"] then + mode' () + else + misnested_tag l t context_name mode' + in + if Stack.in_scope open_elements "ruby" then + pop_implied ~except:"rtc" l finish + else + finish ()) + (fun () -> + push_and_emit l t mode) + + | l, `Start ({name = "math"} as t) -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true ~namespace:`MathML l t (fun () -> + if t.self_closing then pop l mode + else mode ())) + + | l, `Start ({name = "svg"} as t) -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true ~namespace:`SVG l t (fun () -> + if t.self_closing then pop l mode + else mode ())) + + | l, `Start ({name = + "caption" | "col" | "colgroup" | "frame" | "head" | "tbody" | "td" | + "tfoot" | "th" | "thead" | "tr"} as t) -> + misnested_tag l t context_name mode + + | l, `Start t -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t mode) + + | l, `End {name} -> + any_other_end_tag_in_body l name mode + + (* Part of 8.2.5.4.7. *) + and any_other_end_tag_in_body l name mode = + let rec close = function + | [] -> mode () + | {element_name = (ns, name') as name''}::rest -> + if ns = `HTML && name' = name then + pop_implied ~except:name l (fun () -> + pop l mode) + else + if Element.is_special name'' then + report l (`Unmatched_end_tag name) !throw mode + else close rest + in + close !(Stack.elements open_elements) + + (* Part of 8.2.5.4.7. *) + and adoption_agency_algorithm l name mode = + Subtree.enable subtree_buffer; + emit_text (fun () -> + let handled, errors = + Subtree.adoption_agency_algorithm + subtree_buffer active_formatting_elements l name + in + let rec report_all errors k = + match errors with + | [] -> k () + | (l, error)::more -> + report l error !throw (fun () -> report_all more k) + in + report_all errors (fun () -> + if not handled then any_other_end_tag_in_body l name mode + else mode ())) + + (* Part of 8.2.5.4.7. *) + and select_in_body l t next_mode = + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t next_mode) + + (* 8.2.5.4.8. *) + and text_mode original_mode = + dispatch tokens begin function + | l, `Char c -> + add_character l c; + text_mode original_mode + + | l, `String s -> + add_string l s; + text_mode original_mode + + | l, `EOF as v -> + report l (`Unexpected_eoi "content") !throw (fun () -> + push tokens v; + pop l original_mode) + + | l, `End _ -> + pop l original_mode + + | _ -> + text_mode original_mode + end + + (* 8.2.5.2. *) + and parse_rcdata original_mode = + set_tokenizer_state `RCDATA; + text_mode original_mode + + (* 8.2.5.2. *) + and parse_rawtext original_mode = + set_tokenizer_state `RAWTEXT; + text_mode original_mode + + and anything_else_in_table mode (l, _ as v) = + report l (`Bad_content "table") !throw (fun () -> + in_body_mode_rules "table" mode v) + + (* 8.2.5.4.9. *) + and in_table_mode () = + dispatch tokens (fun v -> in_table_mode_rules in_table_mode v) + + and in_table_mode_rules mode = function + | (_, `Char _| _, `String _) as v + when Stack.current_element_is open_elements + ["table"; "tbody"; "tfoot"; "thead"; "tr"] -> + push tokens v; + in_table_text_mode true [] mode + + | l, `Comment s -> + emit l (`Comment s) mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + + | l, `Start ({name = "caption"} as t) -> + pop_to_table_context l (fun () -> + Active.add_marker active_formatting_elements; + push_and_emit l t in_caption_mode) + + | l, `Start ({name = "colgroup"} as t) -> + pop_to_table_context l (fun () -> + push_and_emit l t in_column_group_mode) + + | l, `Start {name = "col"} as v -> + pop_to_table_context l (fun () -> + push tokens v; + push_implicit l "colgroup" in_column_group_mode) + + | l, `Start ({name = "tbody" | "tfoot" | "thead"} as t) -> + pop_to_table_context l (fun () -> + push_and_emit l t in_table_body_mode) + + | l, `Start {name = "td" | "th" | "tr"} as v -> + pop_to_table_context l (fun () -> + push tokens v; + push_implicit l "tbody" in_table_body_mode) + + | l, `Start ({name = "table"} as t) as v -> + misnested_tag l t "table" (fun () -> + if not @@ Stack.has open_elements "table" then mode () + else begin + push tokens v; + close_element l "table" (fun () -> reset_mode () ()) + end) + + | l, `End {name = "table"} -> + if not @@ Stack.in_table_scope open_elements "table" then + report l (`Unmatched_end_tag "table") !throw mode + else + close_element l "table" (fun () -> reset_mode () ()) + + | l, `End {name = + "body" | "caption" | "col" | "colgroup" | "html" | "tbody" | "td" | + "tfoot" | "th" | "thead" | "tr" as name} -> + report l (`Unmatched_end_tag name) !throw mode + + | _, `Start {name = "style" | "script" | "template"} + | _, `End {name = "template"} as v -> + in_head_mode_rules mode v + + | l, `Start ({name = "input"} as t) when Element.is_not_hidden t -> + misnested_tag l t "table" (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l mode)) + + | l, `Start ({name = "form"} as t) -> + misnested_tag l t "table" (fun () -> + push_and_emit l t (fun () -> + pop l mode)) + + | _, `EOF as v -> + in_body_mode_rules "table" mode v + + | v -> + anything_else_in_table mode v + + (* 8.2.5.4.10. *) + and in_table_text_mode only_space cs mode = + dispatch tokens begin function + | l, `Char 0 -> + report l (`Bad_token ("U+0000", "table", "null")) !throw (fun () -> + in_table_text_mode only_space cs mode) + + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as v -> + in_table_text_mode only_space (v::cs) mode + + | _, `Char _ as v -> + in_table_text_mode false (v::cs) mode + + | (_, `String s as v) when is_whitespace_only s -> + in_table_text_mode only_space (v::cs) mode + + | _, `String _ as v -> + in_table_text_mode false (v::cs) mode + + | v -> + push tokens v; + if not only_space then + let rec reprocess = function + | [] -> mode () + | v::more -> anything_else_in_table (fun () -> reprocess more) v + in + reprocess (List.rev cs) + else begin + List.rev cs |> List.iter (function + | l, `Char c -> add_character l c + | _ -> ()); + mode () + end + end + + (* 8.2.5.4.11. *) + and in_caption_mode () = + dispatch tokens begin function + | l, `End {name = "caption"} -> + if not @@ Stack.in_table_scope open_elements "caption" then + report l (`Unmatched_end_tag "caption") !throw in_caption_mode + else begin + Active.clear_until_marker active_formatting_elements; + close_element_with_implied "caption" l in_table_mode + end + + | l, `Start ({name = + "caption" | "col" | "colgroup" | "tbody" | "td" | "tfoot" | "th" | + "thead" | "tr"} as t) as v -> + misnested_tag l t "caption" (fun () -> + if not @@ Stack.in_table_scope open_elements "caption" then + in_caption_mode () + else begin + Active.clear_until_marker active_formatting_elements; + push tokens v; + close_element l "caption" in_table_mode + end) + + | l, `End {name = "table"} as v -> + report l (`Unmatched_end_tag "table") !throw (fun () -> + if not @@ Stack.in_table_scope open_elements "caption" then + in_caption_mode () + else begin + Active.clear_until_marker active_formatting_elements; + push tokens v; + close_element l "caption" in_table_mode + end) + + | l, `End {name = + ("body" | "col" | "colgroup" | "html" | "tbody" | "td" | "tfoot" | + "th" | "thead" | "tr") as name} -> + report l (`Unmatched_end_tag name) !throw in_caption_mode + + | l, `Start ({name = "select"} as t) -> + select_in_body l t in_select_in_table_mode + + | v -> + in_body_mode_rules "caption" in_caption_mode v + end + + (* 8.2.5.4.12. *) + and in_column_group_mode () = + dispatch tokens begin function + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + add_character l c; + in_column_group_mode () + + | l, `String s when is_whitespace_only s -> + add_string l s; + in_column_group_mode () + + | l, `Comment s -> + emit l (`Comment s) in_column_group_mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + in_column_group_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "colgroup" in_column_group_mode v + + | l, `Start ({name = "col"} as t) -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l in_column_group_mode) + + | l, `End {name = "colgroup"} -> + if not @@ Stack.current_element_is open_elements ["colgroup"] then + report l (`Unmatched_end_tag "colgroup") !throw in_column_group_mode + else + pop l in_table_mode + + | l, `End {name = "col"} -> + report l (`Unmatched_end_tag "col") !throw in_column_group_mode + + | _, `Start {name = "template"} + | _, `End {name = "template"} as v -> + in_head_mode_rules in_column_group_mode v + + | _, `EOF as v -> + in_body_mode_rules "colgroup" in_column_group_mode v + + | l, _ as v -> + if not @@ Stack.current_element_is open_elements ["colgroup"] then + report l (`Bad_content "colgroup") !throw in_table_mode + else begin + push tokens v; + pop l in_table_mode + end + end + + (* 8.2.5.4.13. *) + and in_table_body_mode () = + dispatch tokens begin function + | l, `Start ({name = "tr"} as t) -> + pop_to_table_body_context l (fun () -> + push_and_emit l t in_row_mode) + + | l, `Start ({name = "th" | "td"} as t) as v -> + misnested_tag l t "table" (fun () -> + pop_to_table_body_context l (fun () -> + push tokens v; + push_implicit l "tr" in_row_mode)) + + | l, `End {name = "tbody" | "tfoot" | "thead" as name} -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_table_body_mode + else + pop_to_table_body_context l (fun () -> + pop l in_table_mode) + + | l, `Start ({name = + "caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead"} as t) + as v -> + if not @@ Stack.one_in_table_scope open_elements + ["tbody"; "thead"; "tfoot"] then + misnested_tag l t "table" in_table_body_mode + else begin + push tokens v; + pop_to_table_body_context l (fun () -> + pop l in_table_mode) + end + + | l, `End {name = "table" as name} as v -> + if not @@ Stack.one_in_table_scope open_elements + ["tbody"; "thead"; "tfoot"] then + report l (`Unmatched_end_tag name) !throw in_table_body_mode + else begin + push tokens v; + pop_to_table_body_context l (fun () -> + pop l in_table_mode) + end + + | l, `End {name = + "body" | "caption" | "col" | "colgroup" | "html" | "td" | "th" | + "tr" as name} -> + report l (`Unmatched_end_tag name) !throw in_table_body_mode + + | v -> + in_table_mode_rules in_table_body_mode v + end + + (* 8.2.5.4.14. *) + and in_row_mode () = + dispatch tokens begin function + | l, `Start ({name = "th" | "td"} as t) -> + Active.add_marker active_formatting_elements; + pop_to_table_row_context l (fun () -> + push_and_emit l t in_cell_mode) + + | l, `End {name = "tr"} -> + if not @@ Stack.in_table_scope open_elements "tr" then + report l (`Unmatched_end_tag "tr") !throw in_row_mode + else + pop_to_table_row_context l (fun () -> + pop l in_table_body_mode) + + | l, `Start {name = + ("caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead" | + "tr")} + | l, `End {name = "table"} as v -> + if not @@ Stack.in_table_scope open_elements "tr" then + match snd v with + | `Start t -> + misnested_tag l t "tr" in_row_mode + | `End {name} -> + report l (`Unmatched_end_tag name) !throw in_row_mode + else + pop_to_table_row_context l (fun () -> + push tokens v; + pop l in_table_body_mode) + + | l, `End {name = "tbody" | "tfoot" | "thead" as name} as v -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_row_mode + else + if not @@ Stack.in_table_scope open_elements "tr" then in_row_mode () + else + pop_to_table_row_context l (fun () -> + push tokens v; + pop l in_table_body_mode) + + | l, `End {name = + "body" | "caption" | "col" | "colgroup" | "html" | "td" | "th" + as name} -> + report l (`Unmatched_end_tag name) !throw in_row_mode + + | v -> + in_table_mode_rules in_row_mode v + end + + (* 8.2.5.4.15. *) + and in_cell_mode () = + dispatch tokens begin function + | l, `End {name = "td" | "th" as name} -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_cell_mode + else + close_element_with_implied name l (fun () -> + Active.clear_until_marker active_formatting_elements; + in_row_mode ()) + + | l, `Start ({name = + "caption" | "col" | "colgroup" | "tbody" | "td" | "tfoot" | "th" | + "thead" | "tr"} as t) as v -> + if not @@ Stack.one_in_table_scope open_elements ["td"; "th"] then + misnested_tag l t "td/th" in_cell_mode + else + close_cell l (fun () -> + Active.clear_until_marker active_formatting_elements; + push tokens v; + in_row_mode ()) + + | l, `End {name = + "body" | "caption" | "col" | "colgroup" | "html" as name} -> + report l (`Unmatched_end_tag name) !throw in_cell_mode + + | l, `End {name = + "table" | "tbody" | "tfoot" | "thead" | "tr" as name} as v -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_cell_mode + else + close_cell l (fun () -> + Active.clear_until_marker active_formatting_elements; + push tokens v; + in_row_mode ()) + + | l, `Start ({name = "select"} as t) -> + select_in_body l t in_select_in_table_mode + + | v -> + in_body_mode_rules "td" in_cell_mode v + end + + (* 8.2.5.4.16. *) + and in_select_mode () = + dispatch tokens (fun v -> in_select_mode_rules in_select_mode v) + + and in_select_mode_rules mode = function + | l, `Char 0 -> + report l (`Bad_token ("U+0000", "select", "null")) !throw mode + + | l, `Char c -> + add_character l c; + mode () + + | l, `String s -> + add_string l s; + mode () + + | l, `Comment s -> + emit l (`Comment s) mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "select" mode v + + | l, `Start ({name = "option"} as t) -> + (fun mode' -> + if Stack.current_element_is open_elements ["option"] then pop l mode' + else mode' ()) + (fun () -> push_and_emit l t mode) + + | l, `Start ({name = "optgroup"} as t) -> + (fun mode' -> + if Stack.current_element_is open_elements ["option"] then pop l mode' + else mode' ()) + @@ (fun mode' () -> + if Stack.current_element_is open_elements ["optgroup"] then pop l mode' + else mode' ()) + @@ (fun () -> push_and_emit l t mode) + + | l, `End {name = "optgroup"} -> + (fun mode' -> + match !(Stack.elements open_elements) with + | {element_name = `HTML, "option"}:: + {element_name = `HTML, "optgroup"}::_ -> + pop l mode' + | _ -> mode' ()) + (fun () -> + if Stack.current_element_is open_elements ["optgroup"] then + pop l mode + else + report l (`Unmatched_end_tag "optgroup") !throw mode) + + | l, `End {name = "option"} -> + if Stack.current_element_is open_elements ["option"] then + pop l mode + else + report l (`Unmatched_end_tag "option") !throw mode + + | l, `End {name = "select"} -> + if not @@ Stack.in_select_scope open_elements "select" then + report l (`Unmatched_end_tag "select") !throw mode + else + close_element l "select" (fun () -> reset_mode () ()) + + | l, `Start ({name = "select"} as t) -> + misnested_tag l t "select" (fun () -> + close_element l "select" (fun () -> reset_mode () ())) + + | l, `Start ({name = "input" | "keygen" | "textarea"} as t) as v -> + misnested_tag l t "select" (fun () -> + if not @@ Stack.in_select_scope open_elements "select" then + mode () + else begin + push tokens v; + close_element l "select" (fun () -> reset_mode () ()) + end) + + | _, (`Start {name = "script" | "template"} | + `End {name = "template"}) as v -> + in_head_mode_rules mode v + + | _, `EOF as v -> + in_body_mode_rules "select" mode v + + | l, _ -> + report l (`Bad_content "select") !throw mode + + (* 8.2.5.4.17. *) + and in_select_in_table_mode () = + dispatch tokens begin function + | l, `Start ({name = + "caption" | "table" | "tbody" | "tfoot" | "thead" | "tr" | "td" | + "th"} as t) as v -> + misnested_tag l t "table" (fun () -> + push tokens v; + close_element l "select" (fun () -> reset_mode () ())) + + | l, `End {name = + "caption" | "table" | "tbody" | "tfoot" | "thead" | "tr" | "td" | + "th" as name} as v -> + report l (`Unmatched_end_tag "name") !throw (fun () -> + if not @@ Stack.in_table_scope open_elements name then + in_select_in_table_mode () + else begin + push tokens v; + close_element l "select" (fun () -> reset_mode () ()) + end) + + | v -> + in_select_mode_rules in_select_in_table_mode v + end + + (* 8.2.5.4.18. *) + and in_template_mode () = + dispatch tokens (fun v -> in_table_mode_rules in_template_mode v) + + (* 8.2.5.4.18. *) + and in_template_mode_rules mode = function + | _, (`Char _ | `Comment _ | `Doctype _ | `String _) as v -> + in_body_mode_rules "template" mode v + + | _, `Start {name = + "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | + "script" | "style" | "template" | "title"} + | _, `End {name = "template"} as v -> + in_head_mode_rules mode v + + | _, `Start {name = + "caption" | "colgroup" | "tbody" | "tfoot" | "thead"} as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_table_mode; + push tokens v; + in_table_mode () + + | _, `Start {name = "col"} as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_column_group_mode; + push tokens v; + in_column_group_mode () + + | _, `Start {name = "tr"} as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_table_body_mode; + push tokens v; + in_table_body_mode () + + | _, `Start {name = "td" | "th"} as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_row_mode; + push tokens v; + in_row_mode () + + | _, `Start _ as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_body_mode; + push tokens v; + in_body_mode () + + | l, `End {name} -> + report l (`Unmatched_end_tag name) !throw mode + + | l, `EOF as v -> + if not @@ Stack.has open_elements "template" then emit_end l + else begin + report l (`Unmatched_end_tag "template") !throw (fun () -> + Active.clear_until_marker active_formatting_elements; + Template.pop template_insertion_modes; + push tokens v; + close_element l "template" (fun () -> reset_mode () ())) + end + + (* 8.2.5.4.19. *) + and after_body_mode () = + dispatch tokens begin function + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as v -> + in_body_mode_rules "html" after_body_mode v + + | (_, `String s) as v when is_whitespace_only s -> + in_body_mode_rules "html" after_body_mode v + + | l, `Comment s -> + emit l (`Comment s) after_body_mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + after_body_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "html" after_body_mode v + + | _, `End {name = "html"} -> + after_after_body_mode () + + | l, `EOF -> + emit_end l + + | l, _ as v -> + report l (`Bad_document "content after body") !throw (fun () -> + push tokens v; + in_body_mode ()) + end + + (* 8.2.5.4.20. *) + and in_frameset_mode () = + dispatch tokens begin function + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + add_character l c; + in_frameset_mode () + + | l, `String s when is_whitespace_only s -> + add_string l s; + in_frameset_mode () + + | l, `Comment s -> + emit l (`Comment s) in_frameset_mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + in_frameset_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "frameset" in_frameset_mode v + + | l, `Start ({name = "frameset"} as t) -> + push_and_emit l t in_frameset_mode + + | l, `End {name = "frameset"} -> + (fun mode' -> + if Stack.current_element_is open_elements ["html"] then + report l (`Unmatched_end_tag "frameset") !throw mode' + else + pop l mode') + (fun () -> + if Stack.current_element_is open_elements ["frameset"] then + in_frameset_mode () + else after_frameset_mode ()) + + | l, `Start ({name = "frame"} as t) -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l in_frameset_mode) + + | _, `Start {name = "noframes"} as v -> + in_head_mode_rules in_frameset_mode v + + | l, `EOF -> + (fun mode' -> + if not @@ Stack.current_element_is open_elements ["html"] then + report l (`Unexpected_eoi "frameset") !throw mode' + else mode' ()) + (fun () -> emit_end l) + + | l, _ -> + report l (`Bad_content "frameset") !throw in_frameset_mode + end + + (* 8.2.5.4.21. *) + and after_frameset_mode () = + dispatch tokens begin function + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + add_character l c; + after_frameset_mode () + + | l, `String s when is_whitespace_only s -> + add_string l s; + after_frameset_mode () + + | l, `Comment s -> + emit l (`Comment s) after_frameset_mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + after_frameset_mode + + | _, `Start {name = "html"} as v -> + in_body_mode_rules "html" after_frameset_mode v + + | l, `End {name = "html"} -> + close_element l "html" after_after_frameset_mode + + | _, `Start {name = "noframes"} as v -> + in_head_mode_rules after_frameset_mode v + + | l, `EOF -> + emit_end l + + | l, _ -> + report l (`Bad_content "html") !throw after_frameset_mode + end + + (* 8.2.5.4.22. *) + and after_after_body_mode () = + dispatch tokens begin function + | l, `Comment s -> + emit l (`Comment s) after_after_body_mode + + | _, `Doctype _ + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) + | _, `Start {name = "html"} as v -> + in_body_mode_rules "html" after_after_body_mode v + + | _, `String s as v when is_whitespace_only s -> + in_body_mode_rules "html" after_after_body_mode v + + | l, `EOF -> + emit_end l + + | l, _ as v -> + push tokens v; + report l (`Bad_content "html") !throw in_body_mode + end + + (* 8.2.5.4.23. *) + and after_after_frameset_mode () = + dispatch tokens begin function + | l, `Comment s -> + emit l (`Comment s) after_after_frameset_mode + + | _, `Doctype _ + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) + | _, `Start {name = "html"} as v -> + in_body_mode_rules "html" after_after_frameset_mode v + + | _, `String s as v when is_whitespace_only s -> + in_body_mode_rules "html" after_after_frameset_mode v + + | l, `EOF -> + emit_end l + + | _, `Start {name = "noframes"} as v -> + in_head_mode_rules after_after_frameset_mode v + + | l, _ -> + report l (`Bad_content "html") !throw after_after_frameset_mode + end + + (* 8.2.5.5. *) + and foreign_start_tag mode l tag = + let namespace = + match Stack.adjusted_current_element context open_elements with + | None -> `HTML + | Some {element_name = ns, _} -> ns + in + + push_and_emit ~acknowledge:true ~namespace l tag (fun () -> + if tag.self_closing then pop l mode + else mode ()) + + and is_html_font_tag tag = + tag.Token_tag.attributes |> List.exists (function + | ("color" | "face" | "size"), _ -> true + | _ -> false) + + and foreign_content mode force_html v = + match v with + | l, `Char 0 -> + report l (`Bad_token ("U+0000", "foreign content", "null")) !throw + (fun () -> + add_character l u_rep; + mode ()) + + | l, `String s -> + add_string l s; + if not @@ is_whitespace_only s then frameset_ok := false; + mode () + + | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> + add_character l c; + mode () + + | l, `Char c -> + frameset_ok := false; + add_character l c; + mode () + + | l, `Comment s -> + emit l (`Comment s) mode + + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + + | l, `Start ({name = + "b" | "big" | "blockquote" | "body" | "br" | "center" | "code" | + "dd" | "div" | "dl" | "dt" | "em" | "embed" | "font" | "h1" | "h2" | + "h3" | "h4" | "h5" | "h6" | "head" | "hr" | "i" | "img" | "li" | + "listing" | "main" | "meta" | "nobr" | "ol" | "p" | "pre" | "ruby" | + "s" | "small" | "span" | "strong" | "strike" | "sub" | "sup" | + "table" | "tt" | "u" | "ul" | "var" as name} as t) as v -> + if name = "font" && not @@ is_html_font_tag t then + foreign_start_tag mode l t + else + misnested_tag l t "xml tag" (fun () -> + push tokens v; + pop l (fun () -> + pop_until (function + | {element_name = `HTML, _} -> true + | {is_html_integration_point = true} -> true + | {element_name} -> + Foreign.is_mathml_text_integration_point element_name) + l mode)) + + | l, `Start t -> + foreign_start_tag mode l t + + | l, `End {name = "script"} + when + match Stack.current_element open_elements with + | Some {element_name = `SVG, "script"} -> true + | _ -> false -> + pop l mode + + | l, `End {name} -> + (fun mode' -> + match Stack.current_element open_elements with + | Some {element_name = _, name'} when String.lowercase_ascii name' = name -> + mode' () + | _ -> + report l (`Unmatched_end_tag name) !throw (fun () -> + mode' ())) + (fun () -> + let rec scan = function + | [] -> mode () + | {element_name = ns, name'}::_ + when String.lowercase_ascii name' = name -> + close_element ~ns l name mode + | {element_name = `HTML, _}::_ -> force_html () + | _::rest -> scan rest + in + scan !(Stack.elements open_elements)) + + | _, `EOF -> force_html () + + in + + construct constructor diff --git a/src/lite/html_parser.mli b/src/lite/html_parser.mli new file mode 100644 index 0000000..a0a1d69 --- /dev/null +++ b/src/lite/html_parser.mli @@ -0,0 +1,13 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +val parse : + ?depth_limit:int -> + [< `Document | `Fragment of string ] option -> + Error.parse_handler -> + (location * Html_tokenizer.token) Kstream.t * + (Html_tokenizer.state -> unit) * + ((unit -> bool) -> unit) -> + (location * signal) Kstream.t From 92bf488eb00a56a99ae84691f37923360e26a807 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 16:55:28 -0400 Subject: [PATCH 006/109] bootstrap markup.lite with Ragel HTML parsing --- src/lite/common.ml | 213 +++++++++++++++++++++++++++++++ src/lite/dune | 16 +++ src/lite/error.ml | 16 +++ src/lite/html_tokenizer.ml | 15 +++ src/lite/html_tokenizer.mli | 15 +++ src/lite/kstream.ml | 6 + src/lite/markup_lite.ml | 46 +++++++ src/lite/markup_lite.mli | 36 ++++++ src/lite/namespace.ml | 207 ++++++++++++++++++++++++++++++ src/lite/ragel_html_tokenizer.ml | 38 ++++++ src/lite/text.ml | 51 ++++++++ test/lite/dune | 4 + test/lite/lite_diff_corpus.ml | 113 ++++++++++++++++ test/lite/oracle.ml | 39 ++++++ 14 files changed, 815 insertions(+) create mode 100644 src/lite/common.ml create mode 100644 src/lite/dune create mode 100644 src/lite/error.ml create mode 100644 src/lite/html_tokenizer.ml create mode 100644 src/lite/html_tokenizer.mli create mode 100644 src/lite/kstream.ml create mode 100644 src/lite/markup_lite.ml create mode 100644 src/lite/markup_lite.mli create mode 100644 src/lite/namespace.ml create mode 100644 src/lite/ragel_html_tokenizer.ml create mode 100644 src/lite/text.ml create mode 100644 test/lite/dune create mode 100644 test/lite/lite_diff_corpus.ml create mode 100644 test/lite/oracle.ml diff --git a/src/lite/common.ml b/src/lite/common.ml new file mode 100644 index 0000000..7fd90ff --- /dev/null +++ b/src/lite/common.ml @@ -0,0 +1,213 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +type 'a cont = 'a -> unit +type 'a cps = exn cont -> 'a cont -> unit + +type location = Markup_common.location + +let compare_locations = Markup_common.compare_locations + +type name = Markup_common.name + +let xml_ns = Markup_common.Ns.xml +let xmlns_ns = Markup_common.Ns.xmlns +let xlink_ns = Markup_common.Ns.xlink +let html_ns = Markup_common.Ns.html +let svg_ns = Markup_common.Ns.svg +let mathml_ns = Markup_common.Ns.mathml + +module Token_tag = +struct + type t = + {name : string; + attributes : (string * string) list; + self_closing : bool} +end + +type xml_declaration = Markup_common.xml_declaration = { + version : string; + encoding : string option; + standalone : bool option; +} + +type doctype = Markup_common.doctype = { + doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool; +} + +type signal = Markup_common.signal + +type general_token = + [ `Xml of xml_declaration + | `Doctype of doctype + | `Start of Token_tag.t + | `End of Token_tag.t + | `Chars of string list + | `Char of int + | `PI of string * string + | `Comment of string + | `EOF ] + +let u_rep = Uchar.to_int Uutf.u_rep + +let add_utf_8 buffer c = + Uutf.Buffer.add_utf_8 buffer (Uchar.unsafe_of_int c) + +let format_char = Printf.sprintf "U+%04X" + +(* Type constraints are necessary to avoid polymorphic comparison, which would + greatly reduce performance: https://github.com/aantron/markup.ml/pull/15. *) +let is_in_range (lower : int) (upper : int) c = c >= lower && c <= upper + +(* HTML 8.2.2.5. *) +let is_control_character = function + | 0x000B -> true + | c when is_in_range 0x0001 0x0008 c -> true + | c when is_in_range 0x000E 0x001F c -> true + | c when is_in_range 0x007F 0x009F c -> true + | _ -> false + +(* HTML 8.2.2.5. *) +let is_non_character = function + | c when is_in_range 0xFDD0 0xFDEF c -> true + | c when (c land 0xFFFF = 0xFFFF) || (c land 0xFFFF = 0xFFFE) -> true + | _ -> false + +let is_digit = is_in_range 0x0030 0x0039 + +let is_hex_digit = function + | c when is_digit c -> true + | c when is_in_range 0x0041 0x0046 c -> true + | c when is_in_range 0x0061 0x0066 c -> true + | _ -> false + +let is_scalar = function + | c when (c >= 0x10FFFF) || ((c >= 0xD800) && (c <= 0xDFFF)) -> false + | _ -> true + +let is_uppercase = is_in_range 0x0041 0x005A + +let is_lowercase = is_in_range 0x0061 0x007A + +let is_alphabetic = function + | c when is_uppercase c -> true + | c when is_lowercase c -> true + | _ -> false + +let is_alphanumeric = function + | c when is_alphabetic c -> true + | c when is_digit c -> true + | _ -> false + +let is_whitespace c = c = 0x0020 || c = 0x000A || c = 0x0009 || c = 0x000D + +let is_whitespace_only s = + try + s |> String.iter (fun c -> + if is_whitespace (int_of_char c) then () + else raise Exit); + true + + with Exit -> false + +let to_lowercase = function + | c when is_uppercase c -> c + 0x20 + | c -> c + +let is_printable = is_in_range 0x0020 0x007E + +let char c = + if is_printable c then begin + let buffer = Buffer.create 4 in + add_utf_8 buffer c; + Buffer.contents buffer + end + else + format_char c + +let is_valid_html_char c = not (is_control_character c || is_non_character c) + +let is_valid_xml_char c = + is_in_range 0x0020 0xD7FF c + || c = 0x0009 + || c = 0x000A + || c = 0x000D + || is_in_range 0xE000 0xFFFD c + || is_in_range 0x10000 0x10FFFF c + +let signal_to_string = Markup_common.signal_to_string + +let token_to_string = function + | `Xml x -> + signal_to_string (`Xml x) + + | `Doctype d -> + signal_to_string (`Doctype d) + + | `Start t -> + let name = "", t.Token_tag.name in + let attributes = + t.Token_tag.attributes |> List.map (fun (n, v) -> ("", n), v) in + let s = signal_to_string (`Start_element (name, attributes)) in + if not t.Token_tag.self_closing then s + else (String.sub s 0 (String.length s - 1)) ^ "/>" + + | `End t -> + Printf.sprintf "" t.Token_tag.name + + | `Chars ss -> + String.concat "" ss + + | `Char i -> + char i + + | `String s -> s + + | `PI v -> + signal_to_string (`PI v) + + | `Comment s -> + signal_to_string (`Comment s) + + | `EOF -> + "EOF" + +let whitespace_chars = " \t\n\r" + +let whitespace_prefix_length s = + let rec loop index = + if index = String.length s then index + else + if String.contains whitespace_chars s.[index] then loop (index + 1) + else index + in + loop 0 + +let whitespace_suffix_length s = + let rec loop rindex = + if rindex = String.length s then rindex + else + if String.contains whitespace_chars s.[String.length s - rindex - 1] then + loop (rindex + 1) + else rindex + in + loop 0 + +let trim_string_left s = + let prefix_length = whitespace_prefix_length s in + String.sub s prefix_length (String.length s - prefix_length) + +let trim_string_right s = + let suffix_length = whitespace_suffix_length s in + String.sub s 0 (String.length s - suffix_length) + +(* String.trim not available for OCaml < 4.00. *) +let trim_string s = s |> trim_string_left |> trim_string_right + +(* Specialization of List.mem at string list, to avoid polymorphic + comparison. *) +let list_mem_string (s : string) l = List.exists (fun s' -> s' = s) l diff --git a/src/lite/dune b/src/lite/dune new file mode 100644 index 0000000..1ca0a52 --- /dev/null +++ b/src/lite/dune @@ -0,0 +1,16 @@ +(library + (name markup_lite) + (public_name markup.lite) + (synopsis "Small fast synchronous HTML parser") + (private_modules + common + error + html_parser + html_tokenizer + kstream + namespace + ragel_html_tokenizer + text) + (libraries devkit markup.common uutf) + (flags + (:standard -w -9))) diff --git a/src/lite/error.ml b/src/lite/error.ml new file mode 100644 index 0000000..85d1068 --- /dev/null +++ b/src/lite/error.ml @@ -0,0 +1,16 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +include Markup_common.Error + +open Common + +type 'a handler = 'a -> t -> unit cps +type parse_handler = location handler +type write_handler = (signal * int) handler + +let ignore_errors _ _ _ resume = resume () + +let report_if report condition location detail throw k = + if condition then report location (detail ()) throw k + else k () diff --git a/src/lite/html_tokenizer.ml b/src/lite/html_tokenizer.ml new file mode 100644 index 0000000..e63b0c0 --- /dev/null +++ b/src/lite/html_tokenizer.ml @@ -0,0 +1,15 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +type token = + [ `Doctype of doctype + | `Start of Token_tag.t + | `End of Token_tag.t + | `Char of int + | `String of string + | `Comment of string + | `EOF ] + +type state = [ `Data | `RCDATA | `RAWTEXT | `Script_data | `PLAINTEXT ] diff --git a/src/lite/html_tokenizer.mli b/src/lite/html_tokenizer.mli new file mode 100644 index 0000000..e63b0c0 --- /dev/null +++ b/src/lite/html_tokenizer.mli @@ -0,0 +1,15 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +type token = + [ `Doctype of doctype + | `Start of Token_tag.t + | `End of Token_tag.t + | `Char of int + | `String of string + | `Comment of string + | `EOF ] + +type state = [ `Data | `RCDATA | `RAWTEXT | `Script_data | `PLAINTEXT ] diff --git a/src/lite/kstream.ml b/src/lite/kstream.ml new file mode 100644 index 0000000..6680a76 --- /dev/null +++ b/src/lite/kstream.ml @@ -0,0 +1,6 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* See the comment in common.ml. *) + +include Markup_common.Kstream diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml new file mode 100644 index 0000000..67fa013 --- /dev/null +++ b/src/lite/markup_lite.ml @@ -0,0 +1,46 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +type async = Markup_common.async +type sync = Markup_common.sync +type ('data, 'sync) stream = ('data, 'sync) Markup_common.stream + +type location = Markup_common.location +type name = Markup_common.name +type xml_declaration = Markup_common.xml_declaration = { + version : string; + encoding : string option; + standalone : bool option; +} +type doctype = Markup_common.doctype = { + doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool; +} +type signal = Markup_common.signal + +module Error = Markup_common.Error +module Ns = Markup_common.Ns + +let signal_to_string = Markup_common.signal_to_string + +let parse_html ?(report = fun _ _ -> ()) + ?(context : [ `Document | `Fragment of string ] = `Document) html = + let report location error throw resume = + match report location error with + | () -> resume () + | exception exn -> throw exn + in + let tokens = Ragel_html_tokenizer.tokenize html |> Kstream.of_list in + Html_parser.parse (Some context) report (tokens, ignore, ignore) + |> Kstream.map (fun (_, signal) _ continue -> continue signal) + |> Markup_common.Stream.Private.to_stream + |> fun stream -> (stream : (signal, sync) stream) + +let iter f stream = + stream + |> Markup_common.Stream.Private.of_stream + |> Kstream.iter (fun value _ continue -> f value; continue ()) + |> fun iterate -> iterate raise ignore diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli new file mode 100644 index 0000000..ade0766 --- /dev/null +++ b/src/lite/markup_lite.mli @@ -0,0 +1,36 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(** Small synchronous HTML parser using types shared with {!Markup}. *) + +type async = Markup_common.async +type sync = Markup_common.sync +type ('data, 'sync) stream = ('data, 'sync) Markup_common.stream + +type location = Markup_common.location +type name = Markup_common.name +type xml_declaration = Markup_common.xml_declaration = { + version : string; + encoding : string option; + standalone : bool option; +} +type doctype = Markup_common.doctype = { + doctype_name : string option; + public_identifier : string option; + system_identifier : string option; + raw_text : string option; + force_quirks : bool; +} +type signal = Markup_common.signal + +module Error = Markup_common.Error +module Ns = Markup_common.Ns + +val signal_to_string : [< signal ] -> string + +val parse_html : + ?report:(location -> Error.t -> unit) -> + ?context:[ `Document | `Fragment of string ] -> + string -> (signal, sync) stream + +val iter : ('a -> unit) -> ('a, sync) stream -> unit diff --git a/src/lite/namespace.ml b/src/lite/namespace.ml new file mode 100644 index 0000000..5286757 --- /dev/null +++ b/src/lite/namespace.ml @@ -0,0 +1,207 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +let list_map_cps : ('a -> 'b cps) -> 'a list -> 'b list cps = + fun f l throw k -> + + let rec loop accumulator = function + | [] -> k (List.rev accumulator) + | x::l -> f x throw (fun x' -> loop (x'::accumulator) l) + in + loop [] l + +module Parsing = +struct + type context_entry = + {f : string -> string option; + previous : context_entry} + + type context = context_entry ref + + let parse qualified_name = + try + let colon_index = String.index qualified_name ':' in + if colon_index = 0 then + raise Not_found; + let prefix = String.sub qualified_name 0 colon_index in + let suffix = + String.sub qualified_name + (colon_index + 1) + (String.length qualified_name - colon_index - 1) + in + prefix, suffix + + with Not_found -> ("", qualified_name) + + let init top_level = + let f = function + | "xml" -> Some xml_ns + | "xmlns" -> Some xmlns_ns + | s -> top_level s + in + let rec entry = {f; previous = entry} in + ref entry + + let expand_element report context raw_element_name throw k = + let ns, name = parse raw_element_name in + match !context.f ns with + | Some uri -> k (uri, name) + | None -> + match ns with + | "" -> k ("", name) + | prefix -> + report () (`Bad_namespace prefix) throw (fun () -> k (prefix, name)) + + let push report context raw_element_name raw_attributes throw k = + let parsed_attributes = + raw_attributes |> List.map (fun (name, value) -> parse name, value) in + + let f = + parsed_attributes |> List.fold_left (fun f -> function + | ("xmlns", prefix), uri -> + (fun p -> if p = prefix then Some uri else f p) + | ("", "xmlns"), uri -> + (fun p -> if p = "" then Some uri else f p) + | _ -> f) + !context.f + in + + let entry = {f; previous = !context} in + context := entry; + + expand_element report context raw_element_name throw + (fun expanded_element_name -> + list_map_cps begin fun (name, value) _ k -> + match name with + | "", "xmlns" -> k ((xmlns_ns, "xmlns"), value) + | "", name -> k (("", name), value) + | ns, name -> + match f ns with + | Some uri -> k ((uri, name), value) + | None -> + report () (`Bad_namespace ns) throw (fun () -> k ((ns, name), value)) + end parsed_attributes throw (fun expanded_attributes -> + k (expanded_element_name, expanded_attributes))) + + let pop ({contents = {previous}} as context) = + context := previous +end + +module StringMap = Map.Make (String) + +module Writing = +struct + type context_entry = + {namespace_to_prefix : string list StringMap.t; + prefix_to_namespace : string StringMap.t; + previous : context_entry} + + type context = context_entry ref * (string -> string option) + + let init top_level = + let namespace_to_prefix = + StringMap.empty + |> StringMap.add "" [""] + |> StringMap.add xml_ns ["xml"] + |> StringMap.add xmlns_ns ["xmlns"] + in + + let prefix_to_namespace = + StringMap.empty + |> StringMap.add "" "" + |> StringMap.add "xml" xml_ns + |> StringMap.add "xmlns" xmlns_ns + in + + let rec entry = + {namespace_to_prefix; prefix_to_namespace; previous = entry} in + + ref entry, top_level + + let lookup report allow_default context namespace throw k = + let candidate_prefixes = + try StringMap.find namespace !(fst context).namespace_to_prefix + with Not_found -> [] + in + + let prefix = + try + Some (candidate_prefixes |> List.find (fun prefix -> + (allow_default || prefix <> "") && + begin + try StringMap.find prefix !(fst context).prefix_to_namespace = + namespace + with Not_found -> false + end)) + with Not_found -> None + in + + let prefix = + match prefix with + | Some _ -> prefix + | None -> + match snd context namespace with + | None -> None + | Some prefix -> + if not allow_default && prefix = "" || + StringMap.mem prefix !(fst context).prefix_to_namespace then + None + else Some prefix + in + + match prefix with + | None -> report () (`Bad_namespace namespace) throw (fun () -> k "") + | Some prefix -> k prefix + + let format prefix name = + match prefix with + | "" -> name + | prefix -> prefix ^ ":" ^ name + + let unexpand_element report context (namespace, name) throw k = + lookup report true context namespace throw (fun prefix -> + k (format prefix name)) + + let unexpand_attribute report context ((namespace, name), value) throw k = + match namespace with + | "" -> k (name, value) + | uri -> + if uri = xmlns_ns && name = "xmlns" then k ("xmlns", value) + else + lookup report false context namespace throw (fun prefix -> + k (format prefix name, value)) + + let extend k v map = + let vs = + try StringMap.find k map + with Not_found -> [] + in + StringMap.add k (v::vs) map + + let push report context element_name attributes throw k = + let namespace_to_prefix, prefix_to_namespace = + attributes |> List.fold_left (fun (ns_to_prefix, prefix_to_ns) -> function + | (ns, "xmlns"), uri when ns = xmlns_ns -> + extend uri "" ns_to_prefix, + StringMap.add "" uri prefix_to_ns + | (ns, prefix), uri when ns = xmlns_ns -> + extend uri prefix ns_to_prefix, + StringMap.add prefix uri prefix_to_ns + | _ -> ns_to_prefix, prefix_to_ns) + (!(fst context).namespace_to_prefix, !(fst context).prefix_to_namespace) + in + + let entry = + {namespace_to_prefix; prefix_to_namespace; previous = !(fst context)} in + (fst context) := entry; + + unexpand_element report context element_name throw (fun element_name -> + list_map_cps (unexpand_attribute report context) attributes throw + (fun attributes -> + k (element_name, attributes))) + + let pop ({contents = {previous}}, _ as context) = + (fst context) := previous +end diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml new file mode 100644 index 0000000..fd43724 --- /dev/null +++ b/src/lite/ragel_html_tokenizer.ml @@ -0,0 +1,38 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +module HS = Devkit.HtmlStream + +let decode raw = + let inner = HS.Raw.project raw in + try Devkit.Web.htmldecode inner with _ -> inner + +let tokenize html : (location * Html_tokenizer.token) list = + let ctx = HS.init () in + let tokens = ref [] in + let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in + let attributes attrs = + List.rev_map (fun (name, value) -> name, decode value) attrs + in + let tag name attributes = + {Token_tag.name; attributes; self_closing = false} + in + let step = function + | HS.Text raw -> emit (`String (decode raw)) + | HS.Tag (name, attrs) -> emit (`Start (tag name (attributes attrs))) + | HS.Close "br" -> () + | HS.Close name -> emit (`End (tag name [])) + | HS.Script (attrs, text) -> + emit (`Start (tag "script" (attributes attrs))); + emit (`String text); + emit (`End (tag "script" [])) + | HS.Style (attrs, text) -> + emit (`Start (tag "style" (attributes attrs))); + emit (`String text); + emit (`End (tag "style" [])) + in + HS.parse ~ctx step html; + emit `EOF; + List.rev !tokens diff --git a/src/lite/text.ml b/src/lite/text.ml new file mode 100644 index 0000000..ad8cf89 --- /dev/null +++ b/src/lite/text.ml @@ -0,0 +1,51 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +type t = + {mutable strings : string list; + buffer : Buffer.t; + mutable location : location option} + +(* This is changed for unit testing. *) +let length_limit = ref (Sys.max_string_length / 2) + +let prepare () = {strings = []; buffer = Buffer.create 256; location = None} + +let note_location text location = + begin match text.location with + | None -> text.location <- Some location + | Some _ -> () + end + +let adding text location = + note_location text location; + + if Buffer.length text.buffer >= !length_limit then begin + text.strings <- (Buffer.contents text.buffer)::text.strings; + Buffer.clear text.buffer + end + +let add text location c = + adding text location; + add_utf_8 text.buffer c + +(* This is only used for strings that are expected to be very small, at the + moment. *) +let add_string text location s = + adding text location; + Buffer.add_string text.buffer s + +let emit text = + match text.location with + | None -> None + | Some location -> + text.location <- None; + if Buffer.length text.buffer = 0 then None + else begin + let strings = (Buffer.contents text.buffer)::text.strings |> List.rev in + text.strings <- []; + Buffer.clear text.buffer; + Some (location, strings) + end diff --git a/test/lite/dune b/test/lite/dune new file mode 100644 index 0000000..932f4ca --- /dev/null +++ b/test/lite/dune @@ -0,0 +1,4 @@ +(executable + (name lite_diff_corpus) + (modules oracle lite_diff_corpus) + (libraries containers devkit markup markup.lite)) diff --git a/test/lite/lite_diff_corpus.ml b/test/lite/lite_diff_corpus.ml new file mode 100644 index 0000000..c6332f4 --- /dev/null +++ b/test/lite/lite_diff_corpus.ml @@ -0,0 +1,113 @@ +let usage program = + Printf.eprintf "Usage: %s DIRECTORY\n" program; + exit 2 + +let html_files directory = + let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in + let rec collect acc = + match files () with + | None -> List.sort String.compare acc + | Some path -> + let path = CCIO.File.to_string path in + collect (if Filename.check_suffix path ".html" then path :: acc else acc) + in + collect [] + +let collect iter stream = + let values = ref [] in + iter (fun value -> values := value :: !values) stream; + List.rev !values + +let equal_lists equal left right = + let rec loop left right = + match left, right with + | [], [] -> true + | l :: ls, r :: rs when equal l r -> loop ls rs + | _ -> false + in + loop left right + +let first_difference to_string left right = + let rec loop index left right = + match left, right with + | [], [] -> "no difference" + | [], _ :: _ -> Printf.sprintf "left ended at signal %d" index + | _ :: _, [] -> Printf.sprintf "right ended at signal %d" index + | l :: ls, r :: rs -> + if l = r then loop (index + 1) ls rs + else Printf.sprintf "signal %d:\n oracle: %s\n lite: %s" + index (to_string l) (to_string r) + in + loop 0 left right + +type result = + | Parsed of Markup_common.signal list * + (Markup_common.location * Markup_common.Error.t) list + | Raised of string * (Markup_common.location * Markup_common.Error.t) list + +let run parse collect_signals html = + let errors = ref [] in + let report location error = errors := (location, error) :: !errors in + try Parsed (collect_signals (parse report html), List.rev !errors) + with exn -> Raised (Printexc.to_string exn, List.rev !errors) + +let compare path oracle lite = + match oracle, lite with + | Parsed (oracle_signals, oracle_errors), Parsed (lite_signals, lite_errors) -> + if not (equal_lists ( = ) oracle_signals lite_signals) then begin + Printf.eprintf "%s: signal mismatch: %s\n" path + (first_difference Markup_common.signal_to_string + oracle_signals lite_signals); + false + end + else if not (equal_lists ( = ) oracle_errors lite_errors) then begin + Printf.eprintf "%s: error/location mismatch\n" path; + false + end + else true + | Raised (oracle_exn, oracle_errors), Raised (lite_exn, lite_errors) -> + if oracle_exn = lite_exn && equal_lists ( = ) oracle_errors lite_errors then true + else begin + Printf.eprintf "%s: exception mismatch:\n oracle: %s\n lite: %s\n" + path oracle_exn lite_exn; + false + end + | Raised (exn, _), Parsed _ -> + Printf.eprintf "%s: oracle raised but Lite did not: %s\n" path exn; + false + | Parsed _, Raised (exn, _) -> + Printf.eprintf "%s: Lite raised but oracle did not: %s\n" path exn; + false + +let () = + let directory = + match Array.to_list Sys.argv with + | [_; directory] -> directory + | _ -> usage Sys.argv.(0) + in + let files = html_files directory in + if files = [] then begin + Printf.eprintf "No .html files found under: %s\n" directory; + exit 2 + end; + let failures = ref 0 in + List.iteri (fun index path -> + let html = CCIO.File.read_exn (CCIO.File.make path) in + let oracle = + run Oracle.parse (collect Markup.iter) html + in + let lite = + run + (fun report html -> Markup_lite.parse_html ~report html) + (collect Markup_lite.iter) html + in + if not (compare path oracle lite) then incr failures; + if (index + 1) mod 100 = 0 then + Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files)) + files; + Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files); + if !failures <> 0 then begin + Printf.eprintf "FAILED: %d files differed\n" !failures; + exit 1 + end; + Printf.printf "OK: %d HTML files matched exactly\n%!" (List.length files) diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml new file mode 100644 index 0000000..09ef2bc --- /dev/null +++ b/test/lite/oracle.ml @@ -0,0 +1,39 @@ +module HS = Devkit.HtmlStream + +let decode raw = + let inner = HS.Raw.project raw in + try Devkit.Web.htmldecode inner with _ -> inner + +let tokenize html : (Markup.location * Markup.Internals.token) list = + let ctx = HS.init () in + let tokens = ref [] in + let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in + let attributes attrs = + List.rev_map (fun (name, value) -> name, decode value) attrs + in + let tag name attributes : Markup.Internals.Token_tag.t = + {name; attributes; self_closing = false} + in + let step = function + | HS.Text raw -> emit (`String (decode raw)) + | HS.Tag (name, attrs) -> emit (`Start (tag name (attributes attrs))) + | HS.Close "br" -> () + | HS.Close name -> emit (`End (tag name [])) + | HS.Script (attrs, text) -> + emit (`Start (tag "script" (attributes attrs))); + emit (`String text); + emit (`End (tag "script" [])) + | HS.Style (attrs, text) -> + emit (`Start (tag "style" (attributes attrs))); + emit (`String text); + emit (`End (tag "style" [])) + in + HS.parse ~ctx step html; + emit `EOF; + List.rev !tokens + +let parse report html = + html + |> tokenize + |> Markup.Internals.parse_tokens ~report ~context:`Document + |> Markup.signals From ff44c554b4d2e3d3b36eacfa950f124911300c2e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 17:13:23 -0400 Subject: [PATCH 007/109] add markup.lite corpus test target --- Makefile | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Makefile b/Makefile index f818e9a..b6f8d56 100644 --- a/Makefile +++ b/Makefile @@ -13,6 +13,14 @@ entities : test : dune runtest +LITE_TEST_EXE := _build/default/test/lite/lite_diff_corpus.exe +LITE_TEST_CORPUS ?= big_tests + +.PHONY : test-lite +test-lite : + dune build --profile release test/lite/lite_diff_corpus.exe + $(LITE_TEST_EXE) $(LITE_TEST_CORPUS) + .PHONY : coverage coverage : find . -name '*.coverage' | xargs rm -f From b26d49f76ed9d8705bfc2937a99316319ee61884 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 17:16:23 -0400 Subject: [PATCH 008/109] report timing and allocations in Lite corpus test --- test/lite/dune | 2 +- test/lite/lite_diff_corpus.ml | 30 ++++++++++++++++++++++++++---- 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/test/lite/dune b/test/lite/dune index 932f4ca..4771fea 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -1,4 +1,4 @@ (executable (name lite_diff_corpus) (modules oracle lite_diff_corpus) - (libraries containers devkit markup markup.lite)) + (libraries containers devkit markup markup.lite unix)) diff --git a/test/lite/lite_diff_corpus.ml b/test/lite/lite_diff_corpus.ml index c6332f4..721a4df 100644 --- a/test/lite/lite_diff_corpus.ml +++ b/test/lite/lite_diff_corpus.ml @@ -45,6 +45,22 @@ type result = (Markup_common.location * Markup_common.Error.t) list | Raised of string * (Markup_common.location * Markup_common.Error.t) list +type stats = { + mutable wall_seconds : float; + mutable minor_words : float; +} + +let empty_stats () = {wall_seconds = 0.; minor_words = 0.} + +let measure stats f = + let minor_words_before = (Gc.quick_stat ()).minor_words in + let wall_before = Unix.gettimeofday () in + let result = f () in + stats.wall_seconds <- stats.wall_seconds +. Unix.gettimeofday () -. wall_before; + stats.minor_words <- + stats.minor_words +. (Gc.quick_stat ()).minor_words -. minor_words_before; + result + let run parse collect_signals html = let errors = ref [] in let report location error = errors := (location, error) :: !errors in @@ -91,21 +107,27 @@ let () = exit 2 end; let failures = ref 0 in + let oracle_stats = empty_stats () in + let lite_stats = empty_stats () in List.iteri (fun index path -> let html = CCIO.File.read_exn (CCIO.File.make path) in - let oracle = - run Oracle.parse (collect Markup.iter) html + let oracle = measure oracle_stats (fun () -> + run Oracle.parse (collect Markup.iter) html) in - let lite = + let lite = measure lite_stats (fun () -> run (fun report html -> Markup_lite.parse_html ~report html) - (collect Markup_lite.iter) html + (collect Markup_lite.iter) html) in if not (compare path oracle lite) then incr failures; if (index + 1) mod 100 = 0 then Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files)) files; Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files); + Printf.printf + "oracle: wall_seconds=%.6f minor_words=%.0f\nlite: wall_seconds=%.6f minor_words=%.0f\n%!" + oracle_stats.wall_seconds oracle_stats.minor_words + lite_stats.wall_seconds lite_stats.minor_words; if !failures <> 0 then begin Printf.eprintf "FAILED: %d files differed\n" !failures; exit 1 From 853f7839b1ddf78bcfbf1255f360115e4a36aa7c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 17:55:59 -0400 Subject: [PATCH 009/109] switch Lite parser to pull token source --- src/lite/dune | 3 +- src/lite/html_parser.ml | 29 +++++++++++-------- src/lite/html_parser.mli | 6 ++-- src/lite/markup_lite.ml | 4 +-- src/lite/token_source.ml | 59 +++++++++++++++++++++++++++++++++++++++ src/lite/token_source.mli | 19 +++++++++++++ 6 files changed, 102 insertions(+), 18 deletions(-) create mode 100644 src/lite/token_source.ml create mode 100644 src/lite/token_source.mli diff --git a/src/lite/dune b/src/lite/dune index 1ca0a52..e72c3b4 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -10,7 +10,8 @@ kstream namespace ragel_html_tokenizer - text) + text + token_source) (libraries devkit markup.common uutf) (flags (:standard -w -9))) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index b7b3bbf..ad3f898 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -147,8 +147,7 @@ sig val uninitialized : unit -> t val initialize : - (location * Html_tokenizer.token) Kstream.t -> - [< simple_context ] option -> + [< simple_context ] -> t -> unit cps @@ -234,17 +233,16 @@ struct let uninitialized () = ref (`Document, None, None) - let initialize tokens requested_context state throw k = + let initialize requested_context state _throw k = (fun k -> match requested_context with - | Some (`Fragment element) -> + | `Fragment element -> (* HTML element names are case-insensitive, even in foreign content. Lowercase the element name given by the user before analysis by the parser, to match this convention. [String.lowercase] is acceptable here because the API assumes the string [element] is in UTF-8. *) k (`Fragment (String.lowercase_ascii element), None) - | Some (`Document as c) -> k (c, None) - | None -> detect tokens throw k) + | `Document as c -> k (c, None)) (fun (detected_context, deciding_token) -> let context = @@ -1026,8 +1024,20 @@ end -let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, set_foreign) = +let parse ?depth_limit requested_context report tokens = let context = Context.uninitialized () in + let tokenizer_state = ref `Data in + let token_location = Token_source.location () in + let next tokens throw _empty k = + match Token_source.next tokens !tokenizer_state token_location with + | token -> k ((token_location.line, token_location.column), token) + | exception exn -> throw exn + in + let next_expected tokens throw k = + next tokens throw (fun () -> throw (Failure "stream empty")) k + in + let push = Token_source.push in + let set_tokenizer_state state = tokenizer_state := state in let throw = ref (fun _ -> ()) in let ended = ref (fun _ -> ()) in @@ -1051,9 +1061,6 @@ let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, se let add_character = Text.add text in let add_string = Text.add_string text in - set_foreign (fun () -> - Stack.current_element_is_foreign context open_elements); - let report_if_stack_has_other_than names k = let rec iterate = function | [] -> k () @@ -1068,7 +1075,7 @@ let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, se let rec current_mode = ref initial_mode and constructor throw_ k = - Context.initialize tokens requested_context context throw_ (fun () -> + Context.initialize requested_context context throw_ (fun () -> let initial_tokenizer_state = match Context.the_context context with diff --git a/src/lite/html_parser.mli b/src/lite/html_parser.mli index a0a1d69..bfc022b 100644 --- a/src/lite/html_parser.mli +++ b/src/lite/html_parser.mli @@ -5,9 +5,7 @@ open Common val parse : ?depth_limit:int -> - [< `Document | `Fragment of string ] option -> + [< `Document | `Fragment of string ] -> Error.parse_handler -> - (location * Html_tokenizer.token) Kstream.t * - (Html_tokenizer.state -> unit) * - ((unit -> bool) -> unit) -> + Token_source.t -> (location * signal) Kstream.t diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index 67fa013..7f98759 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -33,8 +33,8 @@ let parse_html ?(report = fun _ _ -> ()) | () -> resume () | exception exn -> throw exn in - let tokens = Ragel_html_tokenizer.tokenize html |> Kstream.of_list in - Html_parser.parse (Some context) report (tokens, ignore, ignore) + let tokens = Token_source.create html in + Html_parser.parse context report tokens |> Kstream.map (fun (_, signal) _ continue -> continue signal) |> Markup_common.Stream.Private.to_stream |> fun stream -> (stream : (signal, sync) stream) diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml new file mode 100644 index 0000000..eb08501 --- /dev/null +++ b/src/lite/token_source.ml @@ -0,0 +1,59 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +type location_out = { + mutable line : int; + mutable column : int; +} + +type pushed_token = { + token : Html_tokenizer.token; + line : int; + column : int; +} + +type t = { + mutable tokens : (location * Html_tokenizer.token) list; + mutable pushed : pushed_token list; + mutable eof_line : int; + mutable eof_column : int; +} + +let create html = + {tokens = Ragel_html_tokenizer.tokenize html; + pushed = []; + eof_line = 1; + eof_column = -1} + +let location () = {line = 1; column = -1} + +let set_location (out : location_out) line column = + out.line <- line; + out.column <- column + +let next source (_state : Html_tokenizer.state) out = + match source.pushed with + | {token; line; column}::rest -> + source.pushed <- rest; + set_location out line column; + token + | [] -> + match source.tokens with + | ((line, column), token)::rest -> + source.tokens <- rest; + set_location out line column; + begin match token with + | `EOF -> + source.eof_line <- line; + source.eof_column <- column + | _ -> () + end; + token + | [] -> + set_location out source.eof_line source.eof_column; + `EOF + +let push source ((line, column), token) = + source.pushed <- {token; line; column}::source.pushed diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli new file mode 100644 index 0000000..65e5076 --- /dev/null +++ b/src/lite/token_source.mli @@ -0,0 +1,19 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +type location_out = { + mutable line : int; + mutable column : int; +} + +type t + +val create : string -> t +val location : unit -> location_out + +val next : + t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token + +val push : t -> location * Html_tokenizer.token -> unit From 4e801205b7185da3c9918d0d886b1f4bb73c510e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 25 Aug 2026 18:05:00 -0400 Subject: [PATCH 010/109] make Lite Ragel tokenizer resumable --- Makefile | 7 + src/lite/ragel_html_tokenizer.ml | 854 ++++++++++++++++++++++++++-- src/lite/ragel_html_tokenizer.ml.rl | 204 +++++++ src/lite/ragel_html_tokenizer.mli | 14 + src/lite/token_source.ml | 36 +- 5 files changed, 1051 insertions(+), 64 deletions(-) create mode 100644 src/lite/ragel_html_tokenizer.ml.rl create mode 100644 src/lite/ragel_html_tokenizer.mli diff --git a/Makefile b/Makefile index b6f8d56..d050f2c 100644 --- a/Makefile +++ b/Makefile @@ -9,6 +9,13 @@ entities : dune exec src/entities/translate_entities/translate_entities.exe \ > src/entities/entities.ml +.PHONY : lite-ragel +lite-ragel : + cd src/lite && ragel-ocaml -L -F1 \ + -o ragel_html_tokenizer.ml ragel_html_tokenizer.ml.rl + python3 -c 'from pathlib import Path; p = Path("src/lite/ragel_html_tokenizer.ml"); p.write_text("\n".join(line.rstrip() for line in p.read_text().splitlines()) + "\n")' + rm -f src/lite/ragel_html_tokenizer.ri + .PHONY : test test : dune runtest diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index fd43724..16d9bcd 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -1,38 +1,822 @@ -(* This file is part of Markup.ml, released under the MIT license. See - LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) +(* Derived from Devkit's htmlStream_ragel.ml.rl. +Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. +The original source is available from https://github.com/ygrek/ocaml-webstack. *) + +[@@@ocaml.warning "-38-32"] open Common -module HS = Devkit.HtmlStream - -let decode raw = - let inner = HS.Raw.project raw in - try Devkit.Web.htmldecode inner with _ -> inner - -let tokenize html : (location * Html_tokenizer.token) list = - let ctx = HS.init () in - let tokens = ref [] in - let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in - let attributes attrs = - List.rev_map (fun (name, value) -> name, decode value) attrs - in - let tag name attributes = - {Token_tag.name; attributes; self_closing = false} - in - let step = function - | HS.Text raw -> emit (`String (decode raw)) - | HS.Tag (name, attrs) -> emit (`Start (tag name (attributes attrs))) - | HS.Close "br" -> () - | HS.Close name -> emit (`End (tag name [])) - | HS.Script (attrs, text) -> - emit (`Start (tag "script" (attributes attrs))); - emit (`String text); - emit (`End (tag "script" [])) - | HS.Style (attrs, text) -> - emit (`Start (tag "style" (attributes attrs))); - emit (`String text); - emit (`End (tag "style" [])) - in - HS.parse ~ctx step html; - emit `EOF; - List.rev !tokens +type location_out = { + mutable line : int; + mutable column : int; +} + +type t = { + data : string; + cs : int ref; + p : int ref; + pe : int ref; + eof : int ref; + mark : int ref; + mark_end : int ref; + tag : string ref; + key : string ref; + attrs : (string * string) list ref; + directive : string ref; + mutable line : int; + mutable pending : (int * Html_tokenizer.token) list; + mutable finished : bool; +} + +let decode text = +try Devkit.Web.htmldecode text with _ -> text + +let attributes attrs = +List.map (fun (name, value) -> name, decode value) attrs + +let make_tag name attributes = +{Token_tag.name; attributes; self_closing = false} + +let emit scanner token = +scanner.pending <- scanner.pending @ [scanner.line, token] + +let emit_many scanner tokens = +scanner.pending <- +scanner.pending @ List.map (fun token -> scanner.line, token) tokens + +let _htmlstream_trans_keys : int array = [| +1; 10; 1; 10; 0; 22; 1; 1; 1; 22; 1; 6; 1; 6; 1; 6; 1; 12; 1; 22; 0; 22; 0; 22; 0; 22; 0; 22; 0; 12; 0; 12; 1; 10; 1; 3; 1; 3; 0; 22; 1; 12; 1; 5; 1; 5; 0; 22; 0; 22; 0; 22; 0; 22; 0; 12; 1; 10; 0; 12; 0; 12; 1; 10; 1; 3; 1; 3; 0; 22; 1; 5; 1; 5; 0; 22; 1; 12; 1; 22; 1; 22; 1; 10; 1; 10; 0; 10; 0; 20; 1; 14; 1; 19; 1; 16; 1; 18; 1; 21; 0; 12; 1; 1; 1; 10; 1; 10; 0; 10; 0; 20; 1; 21; 1; 22; 1; 17; 1; 15; 0; 12; 1; 1; 1; 10; 1; 10; 0; 10; 0; 21; 1; 16; 1; 21; 1; 17; 1; 15; 0; 12; 1; 1; 1; 12; 1; 1; 0 ; +|] +let _htmlstream_char_class : int array = [| +0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 1; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 2; 3; 4; 4; 4; 4; 5; 4; 4; 4; 4; 4; 6; 7; 8; 9; 9; 9; 9; 9; 9; 9; 9; 9; 9; 7; 4; 10; 11; 12; 13; 4; 9; 9; 14; 9; 15; 9; 9; 9; 16; 9; 9; 17; 9; 9; 9; 18; 9; 19; 20; 21; 9; 9; 9; 9; 22; 9; 4; 4; 4; 4; 7; 4; 9; 9; 14; 9; 15; 9; 9; 9; 16; 9; 9; 17; 9; 9; 9; 18; 9; 19; 20; 21; 9; 9; 9; 9; 22; 9; 0 ; +|] +let _htmlstream_index_offsets : int array = [| +0; 10; 20; 43; 44; 66; 72; 78; 84; 96; 118; 141; 164; 187; 210; 223; 236; 246; 249; 252; 275; 287; 292; 297; 320; 343; 366; 389; 402; 412; 425; 438; 448; 451; 454; 477; 482; 487; 510; 522; 544; 566; 576; 586; 597; 618; 632; 651; 667; 685; 706; 719; 720; 730; 740; 751; 772; 793; 815; 832; 847; 860; 861; 871; 881; 892; 914; 930; 951; 968; 983; 996; 997; 1009; 0 ; +|] +let _htmlstream_indices : int array = [| +2; 1; 1; 1; 1; 1; 1; 1; 1; 3; 6; 5; 5; 5; 5; 5; 5; 5; 5; 7; 3; 10; 11; 9; 9; 9; 12; 12; 13; 12; 9; 9; 9; 14; 12; 12; 12; 12; 12; 12; 12; 12; 12; 16; 18; 9; 9; 9; 9; 19; 9; 9; 20; 9; 9; 9; 9; 20; 20; 20; 20; 20; 20; 20; 20; 20; 18; 9; 9; 9; 9; 22; 24; 22; 22; 22; 22; 25; 24; 22; 22; 22; 22; 27; 24; 22; 22; 22; 22; 27; 22; 22; 22; 22; 22; 0; 18; 9; 9; 9; 9; 30; 30; 9; 30; 9; 9; 9; 9; 30; 30; 30; 30; 30; 30; 30; 30; 30; 32; 33; 9; 9; 9; 9; 30; 30; 9; 30; 9; 9; 34; 35; 30; 30; 30; 30; 30; 30; 30; 30; 30; 37; 38; 9; 9; 9; 9; 39; 39; 9; 39; 9; 9; 40; 41; 39; 39; 39; 39; 39; 39; 39; 39; 39; 43; 44; 9; 9; 9; 9; 45; 45; 9; 45; 9; 46; 47; 48; 45; 45; 45; 45; 45; 45; 45; 45; 45; 50; 51; 9; 9; 9; 9; 52; 52; 9; 52; 9; 53; 54; 55; 52; 52; 52; 52; 52; 52; 52; 52; 52; 53; 58; 57; 59; 57; 60; 57; 57; 57; 57; 57; 57; 9; 63; 64; 62; 9; 62; 9; 62; 62; 62; 62; 62; 62; 65; 68; 67; 67; 67; 67; 67; 67; 67; 67; 69; 72; 71; 73; 76; 75; 77; 79; 80; 9; 9; 9; 9; 52; 52; 9; 52; 9; 9; 54; 55; 52; 52; 52; 52; 52; 52; 52; 52; 52; 18; 9; 9; 9; 9; 9; 9; 9; 9; 9; 9; 40; 84; 83; 83; 83; 73; 87; 86; 86; 86; 77; 89; 90; 9; 9; 9; 9; 91; 91; 92; 91; 9; 9; 93; 9; 91; 91; 91; 91; 91; 91; 91; 91; 91; 95; 96; 9; 9; 9; 9; 97; 97; 98; 97; 9; 9; 99; 9; 97; 97; 97; 97; 97; 97; 97; 97; 97; 101; 102; 9; 9; 9; 9; 103; 103; 104; 103; 9; 105; 106; 9; 103; 103; 103; 103; 103; 103; 103; 103; 103; 108; 109; 9; 9; 9; 9; 110; 110; 111; 110; 9; 112; 113; 9; 110; 110; 110; 110; 110; 110; 110; 110; 110; 98; 115; 9; 9; 9; 9; 9; 9; 9; 9; 9; 9; 116; 119; 118; 118; 118; 118; 118; 118; 118; 118; 120; 112; 123; 122; 124; 122; 125; 122; 122; 122; 122; 122; 122; 9; 128; 129; 127; 9; 127; 9; 127; 127; 127; 127; 127; 127; 130; 133; 132; 132; 132; 132; 132; 132; 132; 132; 134; 137; 136; 138; 141; 140; 142; 144; 145; 9; 9; 9; 9; 110; 110; 111; 110; 9; 9; 113; 9; 110; 110; 110; 110; 110; 110; 110; 110; 110; 148; 147; 147; 147; 138; 151; 150; 150; 150; 142; 154; 155; 153; 153; 153; 153; 156; 156; 153; 156; 153; 153; 157; 153; 156; 156; 156; 156; 156; 156; 156; 156; 156; 160; 159; 159; 159; 159; 159; 159; 159; 159; 159; 159; 0; 163; 162; 162; 162; 162; 164; 164; 162; 164; 162; 162; 165; 162; 164; 164; 164; 164; 164; 164; 164; 164; 164; 18; 9; 9; 9; 9; 9; 9; 9; 20; 9; 9; 9; 9; 20; 20; 20; 20; 20; 20; 20; 20; 20; 169; 168; 168; 168; 168; 168; 168; 168; 168; 170; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 174; 175; 171; 171; 171; 171; 171; 171; 176; 171; 173; 176; 177; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 171; 171; 178; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 179; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 171; 180; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 181; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 182; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 171; 171; 171; 183; 183; 184; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 185; 187; 190; 189; 189; 189; 189; 189; 189; 189; 189; 191; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 195; 196; 192; 192; 192; 192; 192; 192; 197; 192; 194; 197; 198; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 192; 192; 192; 199; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 192; 192; 192; 192; 200; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 192; 192; 192; 192; 192; 201; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 202; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 203; 203; 204; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 205; 207; 210; 209; 209; 209; 209; 209; 209; 209; 209; 211; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 215; 216; 212; 212; 212; 212; 212; 212; 217; 212; 214; 217; 218; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 212; 212; 212; 212; 212; 219; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 220; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 212; 212; 212; 212; 212; 221; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 212; 222; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 223; 223; 224; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 225; 227; 229; 228; 228; 228; 228; 228; 228; 228; 228; 228; 228; 230; 232; 0 ; +|] +let _htmlstream_index_defaults : int array = [| +1; 5; 9; 15; 9; 9; 22; 22; 22; 9; 9; 9; 9; 9; 57; 62; 67; 71; 75; 9; 9; 83; 86; 9; 9; 9; 9; 9; 118; 122; 127; 132; 136; 140; 9; 147; 150; 153; 159; 162; 9; 168; 171; 171; 171; 171; 171; 171; 171; 171; 171; 186; 189; 192; 192; 192; 192; 192; 192; 192; 192; 206; 209; 212; 212; 212; 212; 212; 212; 212; 212; 226; 228; 231; 0 ; +|] +let _htmlstream_cond_targs : int array = [| +0; 1; 1; 2; 1; 1; 1; 2; 2; 3; 2; 4; 23; 37; 40; 3; 3; 4; 3; 5; 9; 5; 6; 6; 6; 7; 7; 8; 8; 9; 10; 10; 11; 11; 16; 20; 11; 11; 11; 12; 16; 20; 12; 13; 13; 12; 14; 16; 20; 13; 13; 13; 12; 14; 16; 20; 14; 15; 14; 17; 21; 15; 15; 11; 11; 16; 16; 1; 1; 2; 17; 18; 18; 19; 18; 18; 18; 19; 19; 11; 11; 20; 21; 22; 22; 22; 22; 22; 23; 24; 24; 23; 27; 31; 24; 24; 24; 25; 27; 31; 25; 26; 26; 25; 27; 29; 31; 26; 26; 26; 25; 27; 29; 31; 27; 27; 28; 28; 1; 1; 2; 29; 30; 29; 32; 35; 30; 30; 24; 24; 31; 31; 1; 1; 2; 32; 33; 33; 34; 33; 33; 33; 34; 34; 24; 24; 35; 36; 36; 36; 36; 36; 37; 38; 37; 37; 39; 0; 38; 38; 38; 39; 38; 38; 39; 0; 40; 41; 42; 42; 43; 42; 42; 43; 43; 43; 44; 44; 45; 46; 47; 48; 49; 50; 50; 51; 51; 51; 52; 53; 53; 54; 53; 53; 54; 54; 54; 55; 55; 56; 57; 58; 59; 60; 60; 61; 61; 61; 62; 63; 63; 64; 63; 63; 64; 64; 64; 65; 65; 66; 67; 68; 69; 70; 70; 71; 71; 71; 72; 72; 73; 73; 73; 0 ; +|] +let _htmlstream_cond_actions : int array = [| +0; 1; 2; 0; 3; 0; 4; 3; 5; 5; 4; 6; 7; 6; 6; 0; 4; 5; 8; 0; 1; 5; 0; 5; 4; 0; 5; 0; 5; 5; 0; 5; 9; 10; 9; 9; 5; 0; 4; 1; 0; 0; 5; 11; 12; 0; 11; 13; 13; 5; 0; 4; 14; 0; 15; 15; 5; 1; 4; 0; 0; 5; 0; 16; 17; 16; 18; 19; 20; 18; 5; 1; 2; 21; 5; 0; 4; 22; 5; 15; 23; 5; 5; 1; 2; 5; 0; 4; 5; 24; 25; 0; 24; 24; 5; 0; 4; 1; 0; 0; 5; 11; 12; 0; 13; 11; 13; 5; 0; 4; 14; 15; 0; 15; 5; 4; 0; 26; 27; 28; 26; 5; 1; 4; 0; 0; 5; 0; 16; 17; 16; 29; 30; 31; 29; 5; 1; 2; 21; 5; 0; 4; 22; 5; 15; 23; 5; 1; 2; 5; 0; 4; 5; 32; 0; 4; 1; 32; 5; 0; 4; 5; 33; 34; 0; 33; 5; 0; 1; 35; 21; 0; 4; 22; 0; 4; 0; 4; 0; 0; 0; 0; 0; 0; 4; 36; 0; 4; 0; 1; 35; 21; 0; 4; 22; 0; 4; 0; 4; 0; 0; 0; 0; 0; 4; 37; 0; 4; 0; 1; 35; 21; 0; 4; 22; 0; 4; 0; 4; 0; 0; 0; 0; 0; 4; 38; 0; 4; 0; 4; 39; 0; 4; 0 ; +|] +let _htmlstream_eof_trans : int array = [| +1; 5; 9; 16; 18; 22; 24; 27; 29; 30; 32; 37; 43; 50; 57; 62; 67; 71; 75; 79; 82; 83; 86; 89; 95; 101; 108; 115; 118; 122; 127; 132; 136; 140; 144; 147; 150; 153; 159; 162; 167; 168; 172; 175; 177; 179; 180; 181; 182; 183; 184; 187; 189; 193; 196; 198; 200; 201; 202; 203; 204; 207; 209; 213; 216; 218; 220; 221; 222; 223; 224; 227; 229; 232; 0 ; +|] +let htmlstream_start : int = 0 +let htmlstream_first_final : int = 0 +let htmlstream_error : int = -1 +let htmlstream_en_in_script : int = 41 +let htmlstream_en_in_style : int = 52 +let htmlstream_en_in_title : int = 62 +let htmlstream_en_garbage_tag : int = 72 +let htmlstream_en_main : int = 0 +let create data = +let cs = ref 0 in +begin + cs := htmlstream_start; + +end; +let length = String.length data in +{data; + cs; + p = ref 0; + pe = ref length; + eof = ref length; + mark = ref (-1); + mark_end = ref (-1); + tag = ref ""; + key = ref ""; + attrs = ref []; + directive = ref ""; + line = 1; + pending = []; + finished = false} + +let run scanner = +let data = scanner.data in +let cs = scanner.cs in +let p = scanner.p in +let pe = scanner.pe in +let eof = scanner.eof in +let mark = scanner.mark in +let mark_end = scanner.mark_end in +let tag = scanner.tag in +let key = scanner.key in +let attrs = scanner.attrs in +let directive = scanner.directive in +pe := !eof; +let pause () = if !p < !eof then pe := !p + 1 in +let substr = String.sub in +let sub () = +assert (!mark >= 0); +if !mark_end < 0 then mark_end := !p; +let text = +if !mark_end <= !mark then "" +else substr data !mark (!mark_end - !mark) +in +mark := -1; +mark_end := -1; +text +in +begin + let _trans : int ref = ref ( 0 ) in + let _keys : int ref = ref 0 in + let _inds : int ref = ref 0 in + let _ic : int ref = ref 0 in + let _have : int ref = ref ( 0 ) in + let _cont : int ref = ref ( 1 ) in + let _again : int ref = ref ( 1 ) in + let _bsc : int ref = ref ( 1 ) in + while _again.contents= 1 && ( p.contents!= pe.contents|| p.contents= eof.contents ) do + begin + _cont := 1; + _again := 1; + if p.contents= eof.contents then + begin + begin + if _htmlstream_eof_trans.(cs.contents)> 0 then + begin + begin + _trans := _htmlstream_eof_trans.(cs.contents)- 1; + + end; + + end + ; + end; + + end + else + begin + begin + _keys := ( cs.contents lsl 1 ); + _inds := _htmlstream_index_offsets.(cs.contents); + if ( Char.code data.[p.contents] )<= 122 && ( Char.code data.[p.contents] )>= 0 then + begin + begin + _ic := _htmlstream_char_class.(( Char.code data.[p.contents] )- 0); + if _ic.contents<= _htmlstream_trans_keys.( _keys.contents+1 )&& _ic.contents>= _htmlstream_trans_keys.( _keys.contents ) then + begin + _trans := _htmlstream_indices.( _inds.contents+ ( _ic.contents- _htmlstream_trans_keys.( _keys.contents ) ) ); + + end + else + begin + _trans := _htmlstream_index_defaults.(cs.contents); + + end + ; + end; + + end + else + begin + begin + _trans := _htmlstream_index_defaults.(cs.contents); + + end; + + end + ; + end; + + end + ;cs := _htmlstream_cond_targs.(_trans.contents); + if _htmlstream_cond_actions.(_trans.contents)!= 0 then + begin + begin + if _htmlstream_cond_actions.(_trans.contents) = 1 then + begin + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 22 then + begin + begin + mark_end := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 24 then + begin + begin + tag := String.lowercase_ascii @@ sub (); attrs := []; + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 33 then + begin + begin + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 9 then + begin + begin + directive := String.lowercase_ascii @@ sub (); attrs := []; + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 3 then + begin + begin + emit scanner (`String (decode (sub ()))); + pause (); + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 11 then + begin + begin + key := String.lowercase_ascii @@ sub () + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 15 then + begin + begin + attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 29 then + begin + begin + match !tag with + | "script" -> begin + p := p.contents- 1; + + end; + begin + cs := 41; + + end; + | "style" -> begin + p := p.contents- 1; + + end; + begin + cs := 52; + + end; + | "title" -> begin + p := p.contents- 1; + + end; + begin + cs := 62; + + end; + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause (); + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 26 then + begin + begin + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [start; `End (make_tag !tag [])]; + pause (); + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 18 then + begin + begin + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 5 then + begin + begin + begin + p := p.contents- 1; + + end; + begin + cs := 72; + + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 4 then + begin + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 6 then + begin + begin + tag := "" + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 21 then + begin + begin + mark := !p + end; + begin + mark_end := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 32 then + begin + begin + mark := !p + end; + begin + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 2 then + begin + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 16 then + begin + begin + mark_end := !p + end; + begin + attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 25 then + begin + begin + tag := String.lowercase_ascii @@ sub (); attrs := []; + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 34 then + begin + begin + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end; + + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 10 then + begin + begin + directive := String.lowercase_ascii @@ sub (); attrs := []; + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 13 then + begin + begin + key := String.lowercase_ascii @@ sub () + end; + begin + attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 12 then + begin + begin + key := String.lowercase_ascii @@ sub () + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 14 then + begin + begin + attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 23 then + begin + begin + attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 30 then + begin + begin + match !tag with + | "script" -> begin + p := p.contents- 1; + + end; + begin + cs := 41; + + end; + | "style" -> begin + p := p.contents- 1; + + end; + begin + cs := 52; + + end; + | "title" -> begin + p := p.contents- 1; + + end; + begin + cs := 62; + + end; + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause (); + + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 39 then + begin + begin + match !tag with + | "script" -> begin + p := p.contents- 1; + + end; + begin + cs := 41; + + end; + | "style" -> begin + p := p.contents- 1; + + end; + begin + cs := 52; + + end; + | "title" -> begin + p := p.contents- 1; + + end; + begin + cs := 62; + + end; + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause (); + + end; + begin + begin + cs := 0; + + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 27 then + begin + begin + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [start; `End (make_tag !tag [])]; + pause (); + + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 19 then + begin + begin + + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 8 then + begin + begin + begin + p := p.contents- 1; + + end; + begin + cs := 72; + + end; + + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 35 then + begin + begin + scanner.line <- scanner.line + 1 + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 36 then + begin + begin + emit_many scanner + [`Start (make_tag "script" (attributes !attrs)); + `String (sub ()); + `End (make_tag "script" [])]; + pause (); + + end; + begin + begin + cs := 0; + + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 37 then + begin + begin + emit_many scanner + [`Start (make_tag "style" (attributes !attrs)); + `String (sub ()); + `End (make_tag "style" [])]; + pause (); + + end; + begin + begin + cs := 0; + + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 38 then + begin + begin + emit_many scanner + [`Start (make_tag "title" (attributes !attrs)); + `String (decode (sub ())); + `End (make_tag "title" [])]; + pause (); + + end; + begin + begin + cs := 0; + + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 7 then + begin + begin + tag := "" + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 17 then + begin + begin + mark_end := !p + end; + begin + attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 31 then + begin + begin + match !tag with + | "script" -> begin + p := p.contents- 1; + + end; + begin + cs := 41; + + end; + | "style" -> begin + p := p.contents- 1; + + end; + begin + cs := 52; + + end; + | "title" -> begin + p := p.contents- 1; + + end; + begin + cs := 62; + + end; + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause (); + + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 28 then + begin + begin + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [start; `End (make_tag !tag [])]; + pause (); + + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 20 then + begin + begin + + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + ; + + end; + + end + ;if _cont.contents= 1 then + begin + begin + if p.contents= eof.contents then + begin + begin + if cs.contents>= 0 then + begin + begin + _cont := 0; + _again := 0; + + end; + + end + ; + end; + + end + else + begin + begin + p := p.contents + 1; + begin + _cont := 0; + _again := 1; + + end; + + end; + + end + ;if _cont.contents= 1 then + begin + begin + begin + _cont := 0; + _again := 0; + + end; + + end; + + end + ; + end; + + end + ; + end; + + done; + +end; +if !p >= !eof then scanner.finished <- true +else if scanner.pending = [] then scanner.finished <- true + +let rec next scanner (_state : Html_tokenizer.state) +(location : location_out) = +match scanner.pending with +| (line, token)::rest -> +scanner.pending <- rest; +location.line <- line; +location.column <- -1; +token +| [] when scanner.finished -> +location.line <- scanner.line; +location.column <- -1; +`EOF +| [] -> +run scanner; +next scanner _state location diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl new file mode 100644 index 0000000..a36b7dd --- /dev/null +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -0,0 +1,204 @@ +(* Derived from Devkit's htmlStream_ragel.ml.rl. + Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. + The original source is available from https://github.com/ygrek/ocaml-webstack. *) + +[@@@ocaml.warning "-38-32"] + +open Common + +type location_out = { + mutable line : int; + mutable column : int; +} + +type t = { + data : string; + cs : int ref; + p : int ref; + pe : int ref; + eof : int ref; + mark : int ref; + mark_end : int ref; + tag : string ref; + key : string ref; + attrs : (string * string) list ref; + directive : string ref; + mutable line : int; + mutable pending : (int * Html_tokenizer.token) list; + mutable finished : bool; +} + +let decode text = + try Devkit.Web.htmldecode text with _ -> text + +let attributes attrs = + List.map (fun (name, value) -> name, decode value) attrs + +let make_tag name attributes = + {Token_tag.name; attributes; self_closing = false} + +let emit scanner token = + scanner.pending <- scanner.pending @ [scanner.line, token] + +let emit_many scanner tokens = + scanner.pending <- + scanner.pending @ List.map (fun token -> scanner.line, token) tokens + +%%{ + machine htmlstream; + + action mark { mark := !p } + action mark_end { mark_end := !p } + action tag { tag := String.lowercase_ascii @@ sub (); attrs := []; } + action close_tag { + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end; + } + action directive { directive := String.lowercase_ascii @@ sub (); attrs := []; } + action text { + emit scanner (`String (decode (sub ()))); + pause (); + } + action key { key := String.lowercase_ascii @@ sub () } + action store_attr { attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs } + action tag_done { + match !tag with + | "script" -> fhold; fgoto in_script; + | "style" -> fhold; fgoto in_style; + | "title" -> fhold; fgoto in_title; + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause (); + } + action tag_done_2 { + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [start; `End (make_tag !tag [])]; + pause (); + } + action directive_done { } + + action garbage_tag { fhold; fgoto garbage_tag; } + + count_newlines = ('\n' >{ scanner.line <- scanner.line + 1 } | ^'\n'+)**; + + wsp = 0..32; + ident = alnum | '-' | [_:.] ; + + in_script := + (count_newlines | any* >mark %mark_end :>> + ('<' wsp* '/' wsp* 'script'i wsp* '>' >{ + emit_many scanner + [`Start (make_tag "script" (attributes !attrs)); + `String (sub ()); + `End (make_tag "script" [])]; + pause (); + } @{fgoto main;})); + in_style := + (count_newlines | any* >mark %mark_end :>> + ('<' wsp* '/' wsp* 'style'i wsp* '>' >{ + emit_many scanner + [`Start (make_tag "style" (attributes !attrs)); + `String (sub ()); + `End (make_tag "style" [])]; + pause (); + } @{fgoto main;})); + in_title := + (count_newlines | any* >mark %mark_end :>> + ('<' wsp* '/' wsp* 'title'i wsp* '>' >{ + emit_many scanner + [`Start (make_tag "title" (attributes !attrs)); + `String (decode (sub ())); + `End (make_tag "title" [])]; + pause (); + } @{fgoto main;})); + + garbage_tag := (count_newlines | ^'>'* '>' @tag_done @{ fgoto main; }); + + literal = + ("'" ^"'"* >mark %mark_end "'" | + '"' ^'"'* >mark %mark_end '"' | + ^(wsp|'"'|"'"|'>')+ >mark %mark_end); + tag_attrs = (wsp+ | ident+ >mark %key wsp* ('=' wsp* literal)? %store_attr )**; + close_tag = '/' wsp* ident* >mark %close_tag <: ^'>'* '>'; + open_tag = ident+ >mark %tag <: wsp* tag_attrs + ('/' wsp* '>' %tag_done_2 | '>' %tag_done); + directive = ('!'|'?') (alnum ident+) >mark %directive <: + wsp* tag_attrs '?'? '>' %directive_done; + comment = "!--" any* :>> "-->"; + tag = '<' wsp* <: + (close_tag | open_tag | directive | comment) + @lerr(garbage_tag) >{ tag := "" }; + main := (((tag | ^'<' >mark ^'<'* %text ) )** | count_newlines); + + write data; +}%% + +let create data = + let cs = ref 0 in + %%write init; + let length = String.length data in + {data; + cs; + p = ref 0; + pe = ref length; + eof = ref length; + mark = ref (-1); + mark_end = ref (-1); + tag = ref ""; + key = ref ""; + attrs = ref []; + directive = ref ""; + line = 1; + pending = []; + finished = false} + +let run scanner = + let data = scanner.data in + let cs = scanner.cs in + let p = scanner.p in + let pe = scanner.pe in + let eof = scanner.eof in + let mark = scanner.mark in + let mark_end = scanner.mark_end in + let tag = scanner.tag in + let key = scanner.key in + let attrs = scanner.attrs in + let directive = scanner.directive in + pe := !eof; + let pause () = if !p < !eof then pe := !p + 1 in + let substr = String.sub in + let sub () = + assert (!mark >= 0); + if !mark_end < 0 then mark_end := !p; + let text = + if !mark_end <= !mark then "" + else substr data !mark (!mark_end - !mark) + in + mark := -1; + mark_end := -1; + text + in + %%write exec; + if !p >= !eof then scanner.finished <- true + else if scanner.pending = [] then scanner.finished <- true + +let rec next scanner (_state : Html_tokenizer.state) + (location : location_out) = + match scanner.pending with + | (line, token)::rest -> + scanner.pending <- rest; + location.line <- line; + location.column <- -1; + token + | [] when scanner.finished -> + location.line <- scanner.line; + location.column <- -1; + `EOF + | [] -> + run scanner; + next scanner _state location diff --git a/src/lite/ragel_html_tokenizer.mli b/src/lite/ragel_html_tokenizer.mli new file mode 100644 index 0000000..5229b39 --- /dev/null +++ b/src/lite/ragel_html_tokenizer.mli @@ -0,0 +1,14 @@ +(* Derived from Devkit's htmlStream_ragel.ml.rl. + Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. *) + +type location_out = { + mutable line : int; + mutable column : int; +} + +type t + +val create : string -> t + +val next : + t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index eb08501..12e9d43 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -3,7 +3,7 @@ open Common -type location_out = { +type location_out = Ragel_html_tokenizer.location_out = { mutable line : int; mutable column : int; } @@ -15,45 +15,23 @@ type pushed_token = { } type t = { - mutable tokens : (location * Html_tokenizer.token) list; + scanner : Ragel_html_tokenizer.t; mutable pushed : pushed_token list; - mutable eof_line : int; - mutable eof_column : int; } let create html = - {tokens = Ragel_html_tokenizer.tokenize html; - pushed = []; - eof_line = 1; - eof_column = -1} + {scanner = Ragel_html_tokenizer.create html; pushed = []} let location () = {line = 1; column = -1} -let set_location (out : location_out) line column = - out.line <- line; - out.column <- column - -let next source (_state : Html_tokenizer.state) out = +let next source state (out : location_out) = match source.pushed with | {token; line; column}::rest -> source.pushed <- rest; - set_location out line column; + out.line <- line; + out.column <- column; token - | [] -> - match source.tokens with - | ((line, column), token)::rest -> - source.tokens <- rest; - set_location out line column; - begin match token with - | `EOF -> - source.eof_line <- line; - source.eof_column <- column - | _ -> () - end; - token - | [] -> - set_location out source.eof_line source.eof_column; - `EOF + | [] -> Ragel_html_tokenizer.next source.scanner state out let push source ((line, column), token) = source.pushed <- {token; line; column}::source.pushed From ac5dce19d381c5b1cf07552b1857c8aa237c1f6f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 10:55:55 -0400 Subject: [PATCH 011/109] buffer Lite Ragel tokens --- src/lite/ragel_html_tokenizer.ml | 61 +++++++++++++++++++---------- src/lite/ragel_html_tokenizer.ml.rl | 47 ++++++++++++++++------ 2 files changed, 75 insertions(+), 33 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 16d9bcd..83aec0e 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -24,7 +24,10 @@ type t = { attrs : (string * string) list ref; directive : string ref; mutable line : int; - mutable pending : (int * Html_tokenizer.token) list; + tokens : Html_tokenizer.token array; + lines : int array; + mutable read : int; + mutable write : int; mutable finished : bool; } @@ -37,12 +40,16 @@ List.map (fun (name, value) -> name, decode value) attrs let make_tag name attributes = {Token_tag.name; attributes; self_closing = false} +let buffer_capacity = 128 +let maximum_transition_output = 3 + let emit scanner token = -scanner.pending <- scanner.pending @ [scanner.line, token] +scanner.tokens.(scanner.write) <- token; +scanner.lines.(scanner.write) <- scanner.line; +scanner.write <- scanner.write + 1 let emit_many scanner tokens = -scanner.pending <- -scanner.pending @ List.map (fun token -> scanner.line, token) tokens +List.iter (emit scanner) tokens let _htmlstream_trans_keys : int array = [| 1; 10; 1; 10; 0; 22; 1; 1; 1; 22; 1; 6; 1; 6; 1; 6; 1; 12; 1; 22; 0; 22; 0; 22; 0; 22; 0; 22; 0; 12; 0; 12; 1; 10; 1; 3; 1; 3; 0; 22; 1; 12; 1; 5; 1; 5; 0; 22; 0; 22; 0; 22; 0; 22; 0; 12; 1; 10; 0; 12; 0; 12; 1; 10; 1; 3; 1; 3; 0; 22; 1; 5; 1; 5; 0; 22; 1; 12; 1; 22; 1; 22; 1; 10; 1; 10; 0; 10; 0; 20; 1; 14; 1; 19; 1; 16; 1; 18; 1; 21; 0; 12; 1; 1; 1; 10; 1; 10; 0; 10; 0; 20; 1; 21; 1; 22; 1; 17; 1; 15; 0; 12; 1; 1; 1; 10; 1; 10; 0; 10; 0; 21; 1; 16; 1; 21; 1; 17; 1; 15; 0; 12; 1; 1; 1; 12; 1; 1; 0 ; @@ -95,7 +102,10 @@ let length = String.length data in attrs = ref []; directive = ref ""; line = 1; - pending = []; + tokens = Array.make buffer_capacity `EOF; + lines = Array.make buffer_capacity 1; + read = 0; + write = 0; finished = false} let run scanner = @@ -111,7 +121,11 @@ let key = scanner.key in let attrs = scanner.attrs in let directive = scanner.directive in pe := !eof; -let pause () = if !p < !eof then pe := !p + 1 in +let pause () = +if scanner.write >= buffer_capacity - maximum_transition_output && +!p < !eof then +pe := !p + 1 +in let substr = String.sub in let sub () = assert (!mark >= 0); @@ -803,20 +817,27 @@ begin end; if !p >= !eof then scanner.finished <- true -else if scanner.pending = [] then scanner.finished <- true +else if scanner.write = 0 then scanner.finished <- true let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = -match scanner.pending with -| (line, token)::rest -> -scanner.pending <- rest; -location.line <- line; -location.column <- -1; -token -| [] when scanner.finished -> -location.line <- scanner.line; -location.column <- -1; -`EOF -| [] -> -run scanner; -next scanner _state location +if scanner.read < scanner.write then begin + let index = scanner.read in + let token = scanner.tokens.(index) in + location.line <- scanner.lines.(index); + location.column <- -1; + scanner.tokens.(index) <- `EOF; + scanner.read <- index + 1; + token +end +else if scanner.finished then begin + location.line <- scanner.line; + location.column <- -1; + `EOF +end +else begin + scanner.read <- 0; + scanner.write <- 0; + run scanner; + next scanner _state location +end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index a36b7dd..0ab23bd 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -24,7 +24,10 @@ type t = { attrs : (string * string) list ref; directive : string ref; mutable line : int; - mutable pending : (int * Html_tokenizer.token) list; + tokens : Html_tokenizer.token array; + lines : int array; + mutable read : int; + mutable write : int; mutable finished : bool; } @@ -37,12 +40,16 @@ let attributes attrs = let make_tag name attributes = {Token_tag.name; attributes; self_closing = false} +let buffer_capacity = 128 +let maximum_transition_output = 3 + let emit scanner token = - scanner.pending <- scanner.pending @ [scanner.line, token] + scanner.tokens.(scanner.write) <- token; + scanner.lines.(scanner.write) <- scanner.line; + scanner.write <- scanner.write + 1 let emit_many scanner tokens = - scanner.pending <- - scanner.pending @ List.map (fun token -> scanner.line, token) tokens + List.iter (emit scanner) tokens %%{ machine htmlstream; @@ -154,7 +161,10 @@ let create data = attrs = ref []; directive = ref ""; line = 1; - pending = []; + tokens = Array.make buffer_capacity `EOF; + lines = Array.make buffer_capacity 1; + read = 0; + write = 0; finished = false} let run scanner = @@ -170,7 +180,11 @@ let run scanner = let attrs = scanner.attrs in let directive = scanner.directive in pe := !eof; - let pause () = if !p < !eof then pe := !p + 1 in + let pause () = + if scanner.write >= buffer_capacity - maximum_transition_output && + !p < !eof then + pe := !p + 1 + in let substr = String.sub in let sub () = assert (!mark >= 0); @@ -185,20 +199,27 @@ let run scanner = in %%write exec; if !p >= !eof then scanner.finished <- true - else if scanner.pending = [] then scanner.finished <- true + else if scanner.write = 0 then scanner.finished <- true let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = - match scanner.pending with - | (line, token)::rest -> - scanner.pending <- rest; - location.line <- line; + if scanner.read < scanner.write then begin + let index = scanner.read in + let token = scanner.tokens.(index) in + location.line <- scanner.lines.(index); location.column <- -1; + scanner.tokens.(index) <- `EOF; + scanner.read <- index + 1; token - | [] when scanner.finished -> + end + else if scanner.finished then begin location.line <- scanner.line; location.column <- -1; `EOF - | [] -> + end + else begin + scanner.read <- 0; + scanner.write <- 0; run scanner; next scanner _state location + end From ad5ed18309e354ef5a72e4d9598bd82779359ae2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 11:20:16 -0400 Subject: [PATCH 012/109] vibecoded html decoder to replace devkit's --- src/lite/dune | 3 +- src/lite/html_entity_decoder.ml | 154 ++++++++++++++++++++++++++++ src/lite/ragel_html_tokenizer.ml | 2 +- src/lite/ragel_html_tokenizer.ml.rl | 2 +- 4 files changed, 158 insertions(+), 3 deletions(-) create mode 100644 src/lite/html_entity_decoder.ml diff --git a/src/lite/dune b/src/lite/dune index e72c3b4..d3789a3 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -5,6 +5,7 @@ (private_modules common error + html_entity_decoder html_parser html_tokenizer kstream @@ -12,6 +13,6 @@ ragel_html_tokenizer text token_source) - (libraries devkit markup.common uutf) + (libraries markup.common markup.entities uutf) (flags (:standard -w -9))) diff --git a/src/lite/html_entity_decoder.ml b/src/lite/html_entity_decoder.ml new file mode 100644 index 0000000..acad282 --- /dev/null +++ b/src/lite/html_entity_decoder.ml @@ -0,0 +1,154 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +let replacement = Uchar.of_int 0xFFFD + +let html4_names = + "lt gt amp quot apos nbsp iexcl cent pound curren yen brvbar sect uml copy \ + ordf laquo not shy reg macr deg plusmn sup2 sup3 acute micro para middot \ + cedil sup1 ordm raquo frac14 frac12 frac34 iquest Agrave Aacute Acirc \ + Atilde Auml Aring AElig Ccedil Egrave Eacute Ecirc Euml Igrave Iacute \ + Icirc Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml times Oslash Ugrave \ + Uacute Ucirc Uuml Yacute THORN szlig agrave aacute acirc atilde auml aring \ + aelig ccedil egrave eacute ecirc euml igrave iacute icirc iuml eth ntilde \ + ograve oacute ocirc otilde ouml divide oslash ugrave uacute ucirc uuml \ + yacute thorn yuml fnof Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota \ + Kappa Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Psi Omega \ + alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi \ + omicron pi rho sigmaf sigma tau upsilon phi chi psi omega thetasym upsih \ + piv bull hellip prime Prime oline frasl weierp image real trade alefsym \ + larr uarr rarr darr harr crarr lArr uArr rArr dArr hArr forall part exist \ + empty nabla isin notin ni prod sum minus lowast radic prop infin ang and or \ + cap cup int there4 sim cong asymp ne equiv le ge sub sup nsub sube supe \ + oplus otimes perp sdot lceil rceil lfloor rfloor lang rang loz spades clubs \ + hearts diams OElig oelig Scaron scaron Yuml circ tilde ensp emsp thinsp zwnj \ + zwj lrm rlm ndash mdash lsquo rsquo sbquo ldquo rdquo bdquo dagger Dagger \ + permil lsaquo rsaquo euro" + +let split_words s = + let rec scan start index words = + if index = String.length s then + if start = index then List.rev words + else List.rev (String.sub s start (index - start)::words) + else if s.[index] = ' ' then + if start = index then scan (index + 1) (index + 1) words + else + scan (index + 1) (index + 1) + (String.sub s start (index - start)::words) + else + scan start (index + 1) words + in + scan 0 0 [] + +let named_entities = + lazy + (let names = Hashtbl.create 253 in + List.iter (fun name -> Hashtbl.add names name ()) (split_words html4_names); + let entities = Hashtbl.create 253 in + Array.iter + (fun (name, value) -> + if Hashtbl.mem names name then Hashtbl.replace entities name value) + Markup_entities.Entities.entities; + (* HTML5 changed [lang] and [rang], and its legacy no-semicolon [sup1] + entry collides with [sup] in the generated table. *) + Hashtbl.replace entities "sup" (`One 0x2283); + Hashtbl.replace entities "lang" (`One 0x2329); + Hashtbl.replace entities "rang" (`One 0x232A); + entities) + +let add_uchar buffer codepoint = + let uchar = + try Uchar.of_int codepoint with Invalid_argument _ -> replacement + in + Uutf.Buffer.add_utf_8 buffer uchar + +let add_utf_8 buffer text position length = + Uutf.String.fold_utf_8 ~pos:position ~len:length + (fun () _ -> function + | `Uchar uchar -> Uutf.Buffer.add_utf_8 buffer uchar + | `Malformed _ -> invalid_arg "malformed UTF-8") + () text + +let is_letter = function + | 'A'..'Z' | 'a'..'z' -> true + | _ -> false + +let is_decimal = function + | '0'..'9' -> true + | _ -> false + +let is_hexadecimal = function + | '0'..'9' | 'A'..'F' | 'a'..'f' -> true + | _ -> false + +let hexadecimal_value = function + | '0'..'9' as c -> Char.code c - Char.code '0' + | 'A'..'F' as c -> Char.code c - Char.code 'A' + 10 + | 'a'..'f' as c -> Char.code c - Char.code 'a' + 10 + | _ -> assert false + +let decode text = + let length = String.length text in + let buffer = Buffer.create length in + let rec search copied index = + if index >= length then + add_utf_8 buffer text copied (length - copied) + else if text.[index] <> '&' then + search copied (index + 1) + else + match reference_end text (index + 1) with + | None -> search copied (index + 1) + | Some (after, value) -> + add_utf_8 buffer text copied (index - copied); + begin match value with + | `Codepoint codepoint -> add_uchar buffer codepoint + | `Name name -> + begin match Hashtbl.find_opt (Lazy.force named_entities) name with + | Some (`One codepoint) -> add_uchar buffer codepoint + | Some (`Two (first, second)) -> + add_uchar buffer first; + add_uchar buffer second + | None -> Uutf.Buffer.add_utf_8 buffer replacement + end + end; + search after after + and reference_end text start = + if start >= length then None + else if text.[start] = '#' then numeric_reference text (start + 1) + else + let finish = consume_while text start is_letter in + if finish > start && finish < length && text.[finish] = ';' then + Some (finish + 1, `Name (String.sub text start (finish - start))) + else + None + and numeric_reference text start = + if start >= length then None + else if text.[start] = 'x' || text.[start] = 'X' then + let digits = start + 1 in + let finish = consume_while text digits is_hexadecimal in + if finish > digits && finish < length && text.[finish] = ';' then begin + let value = ref 0 in + for index = digits to finish - 1 do + value := (!value lsl 4) lor hexadecimal_value text.[index] + done; + Some (finish + 1, `Codepoint !value) + end + else + None + else + let finish = consume_while text start is_decimal in + if finish > start && finish < length && text.[finish] = ';' then + Some + (finish + 1, + `Codepoint + (int_of_string (String.sub text start (finish - start)))) + else + None + and consume_while text index predicate = + if index < length && predicate text.[index] then + consume_while text (index + 1) predicate + else + index + in + search 0 0; + Buffer.contents buffer diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 83aec0e..bf2cc44 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -32,7 +32,7 @@ type t = { } let decode text = -try Devkit.Web.htmldecode text with _ -> text +try Html_entity_decoder.decode text with _ -> text let attributes attrs = List.map (fun (name, value) -> name, decode value) attrs diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 0ab23bd..48cd75e 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -32,7 +32,7 @@ type t = { } let decode text = - try Devkit.Web.htmldecode text with _ -> text + try Html_entity_decoder.decode text with _ -> text let attributes attrs = List.map (fun (name, value) -> name, decode value) attrs From 92dd7f991b8f1675d25cd969bba6bc53d1941ad9 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 11:48:41 -0400 Subject: [PATCH 013/109] html writer in markup.lite, directly to Buffer.t 3x faster: running test-lite: markup writer: wall_seconds=4.473357 minor_words=10,788,248,605 major_words=228,835,444 lite writer: wall_seconds=1.446172 minor_words=526,166,350 major_words=216,989,118 OK: 840 HTML files serialized exactly --- src/lite/dune | 1 + src/lite/html_writer.ml | 182 +++++++++++++++++++++++++++++++++++++++ src/lite/markup_lite.ml | 3 + src/lite/markup_lite.mli | 7 ++ 4 files changed, 193 insertions(+) create mode 100644 src/lite/html_writer.ml diff --git a/src/lite/dune b/src/lite/dune index d3789a3..509ff90 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -8,6 +8,7 @@ html_entity_decoder html_parser html_tokenizer + html_writer kstream namespace ragel_html_tokenizer diff --git a/src/lite/html_writer.ml b/src/lite/html_writer.ml new file mode 100644 index 0000000..35d397f --- /dev/null +++ b/src/lite/html_writer.ml @@ -0,0 +1,182 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +open Common + +let escape_attribute buffer s = + Uutf.String.fold_utf_8 + (fun () _ -> function + | `Malformed _ -> () + | `Uchar c -> ( + match Uchar.to_int c with + | 0x0026 -> Buffer.add_string buffer "&" + | 0x00A0 -> Buffer.add_string buffer " " + | 0x0022 -> Buffer.add_string buffer """ + | c -> add_utf_8 buffer c)) + () s + +let escape_text buffer s = + Uutf.String.fold_utf_8 + (fun () _ -> function + | `Malformed _ -> () + | `Uchar c -> ( + match Uchar.to_int c with + | 0x0026 -> Buffer.add_string buffer "&" + | 0x00A0 -> Buffer.add_string buffer " " + | 0x003C -> Buffer.add_string buffer "<" + | 0x003E -> Buffer.add_string buffer ">" + | c -> add_utf_8 buffer c)) + () s + +let void_elements = + [ + "area"; + "base"; + "basefont"; + "bgsound"; + "br"; + "col"; + "embed"; + "frame"; + "hr"; + "img"; + "input"; + "keygen"; + "link"; + "meta"; + "param"; + "source"; + "track"; + "wbr"; + ] + +let prepend_newline_for = [ "pre"; "textarea"; "listing" ] + +let rec starts_with_newline = function + | [] -> false + | s :: more -> + if String.length s = 0 then starts_with_newline more else s.[0] = '\x0A' + +let literal_text_elements = + [ "style"; "script"; "xmp"; "iframe"; "noembed"; "noframes"; "plaintext" ] + +let element_name = function + | ns, local_name when list_mem_string ns [ html_ns; svg_ns; mathml_ns ] -> + local_name + | ns, local_name when ns = xml_ns -> "xml:" ^ local_name + | ns, local_name when ns = xmlns_ns -> "xmlns:" ^ local_name + | ns, local_name when ns = xlink_ns -> "xlink:" ^ local_name + | _, local_name -> local_name + +let attribute_name = function + | "", local_name -> local_name + | ns, local_name when ns = xml_ns -> "xml:" ^ local_name + | ns, "xmlns" when ns = xmlns_ns -> "xmlns" + | ns, local_name when ns = xmlns_ns -> "xmlns:" ^ local_name + | ns, local_name when ns = xlink_ns -> "xlink:" ^ local_name + | _, local_name -> local_name + +let write ?(escape_attribute = escape_attribute) ?(escape_text = escape_text) + buffer stream = + let signals = Markup_common.Stream.Private.of_stream stream in + let open_elements = ref [] in + let pending = ref None in + + let in_literal_text_element () = + match !open_elements with + | element :: _ -> list_mem_string element literal_text_elements + | [] -> false + in + + let rec next throw ended k = + match !pending with + | Some signal -> + pending := None; + k signal + | None -> Kstream.next signals throw ended k + and peek throw ended k = + next throw ended (fun signal -> + pending := Some signal; + k signal) + and loop throw ended = + next throw ended (fun signal -> + match signal with + | `Start_element (((ns, local_name) as name), attributes) -> + let tag_name = element_name name in + Buffer.add_char buffer '<'; + Buffer.add_string buffer tag_name; + List.iter + (fun (name, value) -> + Buffer.add_char buffer ' '; + Buffer.add_string buffer (attribute_name name); + Buffer.add_string buffer "=\""; + escape_attribute buffer value; + Buffer.add_char buffer '"') + attributes; + Buffer.add_char buffer '>'; + + if ns = html_ns && list_mem_string local_name void_elements then + peek throw + (fun () -> ended ()) + (function + | `End_element -> + next throw + (fun () -> assert false) + (fun _ -> loop throw ended) + | `Start_element _ | `Text _ | `Comment _ | `PI _ | `Xml _ + | `Doctype _ -> + open_elements := tag_name :: !open_elements; + loop throw ended) + else begin + open_elements := tag_name :: !open_elements; + if ns = html_ns && list_mem_string local_name prepend_newline_for + then + peek throw + (fun () -> ended ()) + (function + | `Text strings when starts_with_newline strings -> + Buffer.add_char buffer '\n'; + loop throw ended + | `Text _ | `Start_element _ | `End_element | `Comment _ + | `PI _ | `Doctype _ | `Xml _ -> + loop throw ended) + else loop throw ended + end + | `End_element -> begin + match !open_elements with + | [] -> loop throw ended + | name :: rest -> + open_elements := rest; + Buffer.add_string buffer "'; + loop throw ended + end + | `Text strings -> + if List.for_all (fun s -> String.length s = 0) strings then + loop throw ended + else begin + if in_literal_text_element () then + List.iter (Buffer.add_string buffer) strings + else List.iter (escape_text buffer) strings; + loop throw ended + end + | `Comment s -> + Buffer.add_string buffer ""; + loop throw ended + | `PI (target, s) -> + Buffer.add_string buffer "'; + loop throw ended + | `Doctype _ as doctype -> + Buffer.add_string buffer (signal_to_string doctype); + loop throw ended + | `Xml _ -> loop throw ended) + in + + loop raise (fun () -> ()) diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index 7f98759..650fa75 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -44,3 +44,6 @@ let iter f stream = |> Markup_common.Stream.Private.of_stream |> Kstream.iter (fun value _ continue -> f value; continue ()) |> fun iterate -> iterate raise ignore + +let write_html ?escape_attribute ?escape_text buffer signals = + Html_writer.write ?escape_attribute ?escape_text buffer signals diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index ade0766..f983ae6 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -34,3 +34,10 @@ val parse_html : string -> (signal, sync) stream val iter : ('a -> unit) -> ('a, sync) stream -> unit + +val write_html : + ?escape_attribute:(Buffer.t -> string -> unit) -> + ?escape_text:(Buffer.t -> string -> unit) -> + Buffer.t -> + (signal, sync) stream -> + unit From 1fe18f24ca66d0858c6e36235e5a4cab7f50c86a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 11:49:10 -0400 Subject: [PATCH 014/109] writer test for markup.lite --- Makefile | 5 +- test/lite/dune | 5 + test/lite/lite_writer_diff_corpus.ml | 150 +++++++++++++++++++++++++++ 3 files changed, 159 insertions(+), 1 deletion(-) create mode 100644 test/lite/lite_writer_diff_corpus.ml diff --git a/Makefile b/Makefile index d050f2c..3f6e41a 100644 --- a/Makefile +++ b/Makefile @@ -21,12 +21,15 @@ test : dune runtest LITE_TEST_EXE := _build/default/test/lite/lite_diff_corpus.exe +LITE_WRITER_TEST_EXE := _build/default/test/lite/lite_writer_diff_corpus.exe LITE_TEST_CORPUS ?= big_tests .PHONY : test-lite test-lite : - dune build --profile release test/lite/lite_diff_corpus.exe + dune build --profile release test/lite/lite_diff_corpus.exe \ + test/lite/lite_writer_diff_corpus.exe $(LITE_TEST_EXE) $(LITE_TEST_CORPUS) + $(LITE_WRITER_TEST_EXE) $(LITE_TEST_CORPUS) .PHONY : coverage coverage : diff --git a/test/lite/dune b/test/lite/dune index 4771fea..f3aa011 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -2,3 +2,8 @@ (name lite_diff_corpus) (modules oracle lite_diff_corpus) (libraries containers devkit markup markup.lite unix)) + +(executable + (name lite_writer_diff_corpus) + (modules lite_writer_diff_corpus) + (libraries containers markup markup.lite unix)) diff --git a/test/lite/lite_writer_diff_corpus.ml b/test/lite/lite_writer_diff_corpus.ml new file mode 100644 index 0000000..dd76df9 --- /dev/null +++ b/test/lite/lite_writer_diff_corpus.ml @@ -0,0 +1,150 @@ +let usage program = + Printf.eprintf "Usage: %s DIRECTORY\n" program; + exit 2 + +let html_files directory = + let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in + let rec collect acc = + match files () with + | None -> List.sort String.compare acc + | Some path -> + let path = CCIO.File.to_string path in + collect (if Filename.check_suffix path ".html" then path::acc else acc) + in + collect [] + +let collect stream = + let signals = ref [] in + Markup_lite.iter (fun signal -> signals := signal::!signals) stream; + List.rev !signals + +type stats = { + mutable wall_seconds : float; + mutable minor_words : float; + mutable major_words : float; +} + +let empty_stats () = + {wall_seconds = 0.; minor_words = 0.; major_words = 0.} + +let measure stats f = + let gc_before = Gc.quick_stat () in + let wall_before = Unix.gettimeofday () in + let result = f () in + let wall_after = Unix.gettimeofday () in + let gc_after = Gc.quick_stat () in + stats.wall_seconds <- stats.wall_seconds +. wall_after -. wall_before; + stats.minor_words <- + stats.minor_words +. gc_after.minor_words -. gc_before.minor_words; + stats.major_words <- + stats.major_words +. gc_after.major_words -. gc_before.major_words; + result + +let write_with_markup signals = + signals + |> Markup.of_list + |> Markup.write_html + |> Markup.to_string + +let write_with_lite signals = + let buffer = Buffer.create 4096 in + Markup_lite.write_html buffer (Markup.of_list signals); + Buffer.contents buffer + +let check_buffer_api () = + let wrap prefix buffer text = + Buffer.add_string buffer prefix; + Buffer.add_char buffer '('; + Buffer.add_string buffer text; + Buffer.add_char buffer ')' + in + let signals = + [`Start_element ((Markup.Ns.html, "p"), [("", "id"), "x"]); + `Text ["y"]; + `End_element] + in + let buffer = Buffer.create 64 in + Buffer.add_string buffer "prefix:"; + Markup_lite.write_html + ~escape_attribute:(wrap "A") ~escape_text:(wrap "T") + buffer (Markup.of_list signals); + Markup_lite.write_html buffer (Markup.of_list [`Text ["<&"]]); + let expected = "prefix:

T(y)

<&" in + if Buffer.contents buffer <> expected then begin + Printf.eprintf "buffer API check failed:\n expected: %S\n actual: %S\n" + expected (Buffer.contents buffer); + exit 1 + end + +let difference left right = + let left_length = String.length left in + let right_length = String.length right in + let limit = min left_length right_length in + let rec find index = + if index = limit then index + else if left.[index] = right.[index] then find (index + 1) + else index + in + let index = find 0 in + let context string = + let start = max 0 (index - 24) in + let length = min (String.length string - start) 64 in + String.sub string start length + in + if index = limit then + Printf.sprintf + "output lengths differ at byte %d (Markup: %d, Lite: %d)\n Markup: %S\n Lite: %S" + index left_length right_length (context left) (context right) + else + Printf.sprintf + "output differs at byte %d (Markup: 0x%02X, Lite: 0x%02X)\n Markup: %S\n Lite: %S" + index (Char.code left.[index]) (Char.code right.[index]) + (context left) (context right) + +let () = + check_buffer_api (); + let directory = + match Array.to_list Sys.argv with + | [_; directory] -> directory + | _ -> usage Sys.argv.(0) + in + let files = html_files directory in + if files = [] then begin + Printf.eprintf "No .html files found under: %s\n" directory; + exit 2 + end; + let failures = ref 0 in + let markup_stats = empty_stats () in + let lite_stats = empty_stats () in + List.iteri (fun index path -> + let html = CCIO.File.read_exn (CCIO.File.make path) in + let signals = collect (Markup_lite.parse_html html) in + let markup, lite = + if index mod 2 = 0 then begin + let markup = measure markup_stats (fun () -> write_with_markup signals) in + let lite = measure lite_stats (fun () -> write_with_lite signals) in + markup, lite + end + else begin + let lite = measure lite_stats (fun () -> write_with_lite signals) in + let markup = measure markup_stats (fun () -> write_with_markup signals) in + markup, lite + end + in + if markup <> lite then begin + incr failures; + Printf.eprintf "%s: %s\n" path (difference markup lite) + end; + if (index + 1) mod 100 = 0 then + Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files)) + files; + Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files); + Printf.printf + "markup writer: wall_seconds=%.6f minor_words=%.0f major_words=%.0f\nlite writer: wall_seconds=%.6f minor_words=%.0f major_words=%.0f\n%!" + markup_stats.wall_seconds markup_stats.minor_words markup_stats.major_words + lite_stats.wall_seconds lite_stats.minor_words lite_stats.major_words; + if !failures <> 0 then begin + Printf.eprintf "FAILED: %d files differed\n" !failures; + exit 1 + end; + Printf.printf "OK: %d HTML files serialized exactly\n%!" (List.length files) From 4a8a94bbd5167a6a68972c25b9f8ff4742e4e12c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 11:49:35 -0400 Subject: [PATCH 015/109] format code in src/lite --- src/lite/common.ml | 100 +- src/lite/dune | 14 +- src/lite/error.ml | 4 +- src/lite/html_entity_decoder.ml | 108 +- src/lite/html_parser.ml | 4144 ++++++++++++++--------------- src/lite/html_parser.mli | 2 +- src/lite/markup_lite.ml | 11 +- src/lite/markup_lite.mli | 7 +- src/lite/namespace.ml | 202 +- src/lite/ragel_html_tokenizer.ml | 3457 ++++++++++++++++++------ src/lite/ragel_html_tokenizer.mli | 10 +- src/lite/text.ml | 30 +- src/lite/token_source.ml | 24 +- src/lite/token_source.mli | 11 +- 14 files changed, 4869 insertions(+), 3255 deletions(-) diff --git a/src/lite/common.ml b/src/lite/common.ml index 7fd90ff..0b08a8e 100644 --- a/src/lite/common.ml +++ b/src/lite/common.ml @@ -3,7 +3,6 @@ type 'a cont = 'a -> unit type 'a cps = exn cont -> 'a cont -> unit - type location = Markup_common.location let compare_locations = Markup_common.compare_locations @@ -17,12 +16,12 @@ let html_ns = Markup_common.Ns.html let svg_ns = Markup_common.Ns.svg let mathml_ns = Markup_common.Ns.mathml -module Token_tag = -struct - type t = - {name : string; - attributes : (string * string) list; - self_closing : bool} +module Token_tag = struct + type t = { + name : string; + attributes : (string * string) list; + self_closing : bool; + } end type xml_declaration = Markup_common.xml_declaration = { @@ -53,10 +52,7 @@ type general_token = | `EOF ] let u_rep = Uchar.to_int Uutf.u_rep - -let add_utf_8 buffer c = - Uutf.Buffer.add_utf_8 buffer (Uchar.unsafe_of_int c) - +let add_utf_8 buffer c = Uutf.Buffer.add_utf_8 buffer (Uchar.unsafe_of_int c) let format_char = Printf.sprintf "U+%04X" (* Type constraints are necessary to avoid polymorphic comparison, which would @@ -74,7 +70,7 @@ let is_control_character = function (* HTML 8.2.2.5. *) let is_non_character = function | c when is_in_range 0xFDD0 0xFDEF c -> true - | c when (c land 0xFFFF = 0xFFFF) || (c land 0xFFFF = 0xFFFE) -> true + | c when c land 0xFFFF = 0xFFFF || c land 0xFFFF = 0xFFFE -> true | _ -> false let is_digit = is_in_range 0x0030 0x0039 @@ -86,11 +82,10 @@ let is_hex_digit = function | _ -> false let is_scalar = function - | c when (c >= 0x10FFFF) || ((c >= 0xD800) && (c <= 0xDFFF)) -> false + | c when c >= 0x10FFFF || (c >= 0xD800 && c <= 0xDFFF) -> false | _ -> true let is_uppercase = is_in_range 0x0041 0x005A - let is_lowercase = is_in_range 0x0061 0x007A let is_alphabetic = function @@ -107,17 +102,13 @@ let is_whitespace c = c = 0x0020 || c = 0x000A || c = 0x0009 || c = 0x000D let is_whitespace_only s = try - s |> String.iter (fun c -> - if is_whitespace (int_of_char c) then () - else raise Exit); + s + |> String.iter (fun c -> + if is_whitespace (int_of_char c) then () else raise Exit); true - with Exit -> false -let to_lowercase = function - | c when is_uppercase c -> c + 0x20 - | c -> c - +let to_lowercase = function c when is_uppercase c -> c + 0x20 | c -> c let is_printable = is_in_range 0x0020 0x007E let char c = @@ -126,74 +117,53 @@ let char c = add_utf_8 buffer c; Buffer.contents buffer end - else - format_char c + else format_char c let is_valid_html_char c = not (is_control_character c || is_non_character c) let is_valid_xml_char c = is_in_range 0x0020 0xD7FF c - || c = 0x0009 - || c = 0x000A - || c = 0x000D + || c = 0x0009 || c = 0x000A || c = 0x000D || is_in_range 0xE000 0xFFFD c || is_in_range 0x10000 0x10FFFF c let signal_to_string = Markup_common.signal_to_string let token_to_string = function - | `Xml x -> - signal_to_string (`Xml x) - - | `Doctype d -> - signal_to_string (`Doctype d) - + | `Xml x -> signal_to_string (`Xml x) + | `Doctype d -> signal_to_string (`Doctype d) | `Start t -> - let name = "", t.Token_tag.name in - let attributes = - t.Token_tag.attributes |> List.map (fun (n, v) -> ("", n), v) in - let s = signal_to_string (`Start_element (name, attributes)) in - if not t.Token_tag.self_closing then s - else (String.sub s 0 (String.length s - 1)) ^ "/>" - - | `End t -> - Printf.sprintf "" t.Token_tag.name - - | `Chars ss -> - String.concat "" ss - - | `Char i -> - char i - + let name = ("", t.Token_tag.name) in + let attributes = + t.Token_tag.attributes |> List.map (fun (n, v) -> (("", n), v)) + in + let s = signal_to_string (`Start_element (name, attributes)) in + if not t.Token_tag.self_closing then s + else String.sub s 0 (String.length s - 1) ^ "/>" + | `End t -> Printf.sprintf "" t.Token_tag.name + | `Chars ss -> String.concat "" ss + | `Char i -> char i | `String s -> s - - | `PI v -> - signal_to_string (`PI v) - - | `Comment s -> - signal_to_string (`Comment s) - - | `EOF -> - "EOF" + | `PI v -> signal_to_string (`PI v) + | `Comment s -> signal_to_string (`Comment s) + | `EOF -> "EOF" let whitespace_chars = " \t\n\r" let whitespace_prefix_length s = let rec loop index = if index = String.length s then index - else - if String.contains whitespace_chars s.[index] then loop (index + 1) - else index + else if String.contains whitespace_chars s.[index] then loop (index + 1) + else index in loop 0 let whitespace_suffix_length s = let rec loop rindex = if rindex = String.length s then rindex - else - if String.contains whitespace_chars s.[String.length s - rindex - 1] then - loop (rindex + 1) - else rindex + else if String.contains whitespace_chars s.[String.length s - rindex - 1] + then loop (rindex + 1) + else rindex in loop 0 diff --git a/src/lite/dune b/src/lite/dune index 509ff90..55ffb7e 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -2,18 +2,8 @@ (name markup_lite) (public_name markup.lite) (synopsis "Small fast synchronous HTML parser") - (private_modules - common - error - html_entity_decoder - html_parser - html_tokenizer - html_writer - kstream - namespace - ragel_html_tokenizer - text - token_source) + (private_modules common error html_entity_decoder html_parser html_tokenizer + html_writer kstream namespace ragel_html_tokenizer text token_source) (libraries markup.common markup.entities uutf) (flags (:standard -w -9))) diff --git a/src/lite/error.ml b/src/lite/error.ml index 85d1068..f69362b 100644 --- a/src/lite/error.ml +++ b/src/lite/error.ml @@ -2,7 +2,6 @@ LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) include Markup_common.Error - open Common type 'a handler = 'a -> t -> unit cps @@ -12,5 +11,4 @@ type write_handler = (signal * int) handler let ignore_errors _ _ _ resume = resume () let report_if report condition location detail throw k = - if condition then report location (detail ()) throw k - else k () + if condition then report location (detail ()) throw k else k () diff --git a/src/lite/html_entity_decoder.ml b/src/lite/html_entity_decoder.ml index acad282..f10e44e 100644 --- a/src/lite/html_entity_decoder.ml +++ b/src/lite/html_entity_decoder.ml @@ -7,36 +7,35 @@ let html4_names = "lt gt amp quot apos nbsp iexcl cent pound curren yen brvbar sect uml copy \ ordf laquo not shy reg macr deg plusmn sup2 sup3 acute micro para middot \ cedil sup1 ordm raquo frac14 frac12 frac34 iquest Agrave Aacute Acirc \ - Atilde Auml Aring AElig Ccedil Egrave Eacute Ecirc Euml Igrave Iacute \ - Icirc Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml times Oslash Ugrave \ - Uacute Ucirc Uuml Yacute THORN szlig agrave aacute acirc atilde auml aring \ - aelig ccedil egrave eacute ecirc euml igrave iacute icirc iuml eth ntilde \ - ograve oacute ocirc otilde ouml divide oslash ugrave uacute ucirc uuml \ - yacute thorn yuml fnof Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota \ - Kappa Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Psi Omega \ - alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi \ - omicron pi rho sigmaf sigma tau upsilon phi chi psi omega thetasym upsih \ - piv bull hellip prime Prime oline frasl weierp image real trade alefsym \ - larr uarr rarr darr harr crarr lArr uArr rArr dArr hArr forall part exist \ - empty nabla isin notin ni prod sum minus lowast radic prop infin ang and or \ - cap cup int there4 sim cong asymp ne equiv le ge sub sup nsub sube supe \ - oplus otimes perp sdot lceil rceil lfloor rfloor lang rang loz spades clubs \ - hearts diams OElig oelig Scaron scaron Yuml circ tilde ensp emsp thinsp zwnj \ - zwj lrm rlm ndash mdash lsquo rsquo sbquo ldquo rdquo bdquo dagger Dagger \ - permil lsaquo rsaquo euro" + Atilde Auml Aring AElig Ccedil Egrave Eacute Ecirc Euml Igrave Iacute Icirc \ + Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml times Oslash Ugrave Uacute \ + Ucirc Uuml Yacute THORN szlig agrave aacute acirc atilde auml aring aelig \ + ccedil egrave eacute ecirc euml igrave iacute icirc iuml eth ntilde ograve \ + oacute ocirc otilde ouml divide oslash ugrave uacute ucirc uuml yacute \ + thorn yuml fnof Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa \ + Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Psi Omega alpha \ + beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi omicron \ + pi rho sigmaf sigma tau upsilon phi chi psi omega thetasym upsih piv bull \ + hellip prime Prime oline frasl weierp image real trade alefsym larr uarr \ + rarr darr harr crarr lArr uArr rArr dArr hArr forall part exist empty nabla \ + isin notin ni prod sum minus lowast radic prop infin ang and or cap cup int \ + there4 sim cong asymp ne equiv le ge sub sup nsub sube supe oplus otimes \ + perp sdot lceil rceil lfloor rfloor lang rang loz spades clubs hearts diams \ + OElig oelig Scaron scaron Yuml circ tilde ensp emsp thinsp zwnj zwj lrm rlm \ + ndash mdash lsquo rsquo sbquo ldquo rdquo bdquo dagger Dagger permil lsaquo \ + rsaquo euro" let split_words s = let rec scan start index words = if index = String.length s then if start = index then List.rev words - else List.rev (String.sub s start (index - start)::words) + else List.rev (String.sub s start (index - start) :: words) else if s.[index] = ' ' then if start = index then scan (index + 1) (index + 1) words else scan (index + 1) (index + 1) - (String.sub s start (index - start)::words) - else - scan start (index + 1) words + (String.sub s start (index - start) :: words) + else scan start (index + 1) words in scan 0 0 [] @@ -69,49 +68,42 @@ let add_utf_8 buffer text position length = | `Malformed _ -> invalid_arg "malformed UTF-8") () text -let is_letter = function - | 'A'..'Z' | 'a'..'z' -> true - | _ -> false - -let is_decimal = function - | '0'..'9' -> true - | _ -> false +let is_letter = function 'A' .. 'Z' | 'a' .. 'z' -> true | _ -> false +let is_decimal = function '0' .. '9' -> true | _ -> false let is_hexadecimal = function - | '0'..'9' | 'A'..'F' | 'a'..'f' -> true + | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true | _ -> false let hexadecimal_value = function - | '0'..'9' as c -> Char.code c - Char.code '0' - | 'A'..'F' as c -> Char.code c - Char.code 'A' + 10 - | 'a'..'f' as c -> Char.code c - Char.code 'a' + 10 + | '0' .. '9' as c -> Char.code c - Char.code '0' + | 'A' .. 'F' as c -> Char.code c - Char.code 'A' + 10 + | 'a' .. 'f' as c -> Char.code c - Char.code 'a' + 10 | _ -> assert false let decode text = let length = String.length text in let buffer = Buffer.create length in let rec search copied index = - if index >= length then - add_utf_8 buffer text copied (length - copied) - else if text.[index] <> '&' then - search copied (index + 1) + if index >= length then add_utf_8 buffer text copied (length - copied) + else if text.[index] <> '&' then search copied (index + 1) else match reference_end text (index + 1) with | None -> search copied (index + 1) | Some (after, value) -> - add_utf_8 buffer text copied (index - copied); - begin match value with - | `Codepoint codepoint -> add_uchar buffer codepoint - | `Name name -> - begin match Hashtbl.find_opt (Lazy.force named_entities) name with - | Some (`One codepoint) -> add_uchar buffer codepoint - | Some (`Two (first, second)) -> - add_uchar buffer first; - add_uchar buffer second - | None -> Uutf.Buffer.add_utf_8 buffer replacement - end - end; - search after after + add_utf_8 buffer text copied (index - copied); + begin match value with + | `Codepoint codepoint -> add_uchar buffer codepoint + | `Name name -> begin + match Hashtbl.find_opt (Lazy.force named_entities) name with + | Some (`One codepoint) -> add_uchar buffer codepoint + | Some (`Two (first, second)) -> + add_uchar buffer first; + add_uchar buffer second + | None -> Uutf.Buffer.add_utf_8 buffer replacement + end + end; + search after after and reference_end text start = if start >= length then None else if text.[start] = '#' then numeric_reference text (start + 1) @@ -119,8 +111,7 @@ let decode text = let finish = consume_while text start is_letter in if finish > start && finish < length && text.[finish] = ';' then Some (finish + 1, `Name (String.sub text start (finish - start))) - else - None + else None and numeric_reference text start = if start >= length then None else if text.[start] = 'x' || text.[start] = 'X' then @@ -133,22 +124,19 @@ let decode text = done; Some (finish + 1, `Codepoint !value) end - else - None + else None else let finish = consume_while text start is_decimal in if finish > start && finish < length && text.[finish] = ';' then Some - (finish + 1, - `Codepoint - (int_of_string (String.sub text start (finish - start)))) - else - None + ( finish + 1, + `Codepoint (int_of_string (String.sub text start (finish - start))) + ) + else None and consume_while text index predicate = if index < length && predicate text.[index] then consume_while text (index + 1) predicate - else - index + else index in search 0 0; Buffer.contents buffer diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index ad3f898..aae9e85 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -5,17 +5,13 @@ open Common open Token_tag open Kstream - - (* Namespaces for pattern matching. *) type ns = [ `HTML | `MathML | `SVG | `Other of string ] type qname = ns * string -module Ns : -sig +module Ns : sig val to_string : ns -> string -end = -struct +end = struct let to_string = function | `HTML -> html_ns | `MathML -> mathml_ns @@ -28,25 +24,24 @@ end let list_mem_qname ((ns, tag) : qname) l = let rec loop = function | [] -> false - | (ns', tag')::_ when ns' = ns && tag' = tag -> true - | _::rest -> loop rest + | (ns', tag') :: _ when ns' = ns && tag' = tag -> true + | _ :: rest -> loop rest in loop l - - (* Elements. *) -type element = - {element_name : qname; - location : location; - is_html_integration_point : bool; - suppress : bool; - mutable buffering : bool; - mutable is_open : bool; - mutable attributes : (name * string) list; - mutable end_location : location; - mutable children : annotated_node list; - mutable parent : element} +type element = { + element_name : qname; + location : location; + is_html_integration_point : bool; + suppress : bool; + mutable buffering : bool; + mutable is_open : bool; + mutable attributes : (name * string) list; + mutable end_location : location; + mutable children : annotated_node list; + mutable parent : element; +} and node = | Element of element @@ -56,175 +51,254 @@ and node = and annotated_node = location * node - - (* Element helpers. *) -module Element : -sig +module Element : sig val create : ?is_html_integration_point:bool -> ?suppress:bool -> - qname -> location -> - element - val dummy : element + qname -> + location -> + element + val dummy : element val is_special : qname -> bool val is_not_hidden : Token_tag.t -> bool -end = -struct +end = struct let rec dummy = - {element_name = `HTML, "dummy"; - location = 1, 1; - is_html_integration_point = false; - suppress = true; - buffering = false; - is_open = false; - attributes = []; - end_location = 1, 1; - children = []; - parent = dummy} - - let create - ?(is_html_integration_point = false) ?(suppress = false) name location = - {element_name = name; - location; - is_html_integration_point; - suppress; - buffering = false; - is_open = true; - attributes = []; - end_location = 1, 1; - children = []; - parent = dummy} + { + element_name = (`HTML, "dummy"); + location = (1, 1); + is_html_integration_point = false; + suppress = true; + buffering = false; + is_open = false; + attributes = []; + end_location = (1, 1); + children = []; + parent = dummy; + } + + let create ?(is_html_integration_point = false) ?(suppress = false) name + location = + { + element_name = name; + location; + is_html_integration_point; + suppress; + buffering = false; + is_open = true; + attributes = []; + end_location = (1, 1); + children = []; + parent = dummy; + } let is_special name = list_mem_qname name - [`HTML, "address"; `HTML, "applet"; `HTML, "area"; - `HTML, "article"; `HTML, "aside"; `HTML, "base"; - `HTML, "basefont"; `HTML, "bgsound"; `HTML, "blockquote"; - `HTML, "body"; `HTML, "br"; `HTML, "button"; - `HTML, "caption"; `HTML, "center"; `HTML, "col"; - `HTML, "colgroup"; `HTML, "dd"; `HTML, "details"; - `HTML, "dir"; `HTML, "div"; `HTML, "dl"; - `HTML, "dt"; `HTML, "embed"; `HTML, "fieldset"; - `HTML, "figcaption"; `HTML, "figure"; `HTML, "footer"; - `HTML, "form"; `HTML, "frame"; `HTML, "frameset"; - `HTML, "h1"; `HTML, "h2"; `HTML, "h3"; - `HTML, "h4"; `HTML, "h5"; `HTML, "h6"; - `HTML, "head"; `HTML, "header"; `HTML, "hgroup"; - `HTML, "hr"; `HTML, "html"; `HTML, "iframe"; - `HTML, "img"; `HTML, "input"; `HTML, "isindex"; - `HTML, "li"; `HTML, "link"; `HTML, "listing"; - `HTML, "main"; `HTML, "marquee"; `HTML, "meta"; - `HTML, "nav"; `HTML, "noembed"; `HTML, "noframes"; - `HTML, "noscript"; `HTML, "object"; `HTML, "ol"; - `HTML, "p"; `HTML, "param"; `HTML, "plaintext"; - `HTML, "pre"; `HTML, "script"; `HTML, "section"; - `HTML, "select"; `HTML, "source"; `HTML, "style"; - `HTML, "summary"; `HTML, "table"; `HTML, "tbody"; - `HTML, "td"; `HTML, "template"; `HTML, "textarea"; - `HTML, "tfoot"; `HTML, "th"; `HTML, "thead"; - `HTML, "title"; `HTML, "tr"; `HTML, "track"; - `HTML, "ul"; `HTML, "wbr"; `HTML, "xmp"; - `MathML, "mi"; `MathML, "mo"; `MathML, "mn"; - `MathML, "ms"; `MathML, "mtext"; `MathML, "annotation-xml"; - `SVG, "foreignObject"; `SVG, "desc"; `SVG, "title"] + [ + (`HTML, "address"); + (`HTML, "applet"); + (`HTML, "area"); + (`HTML, "article"); + (`HTML, "aside"); + (`HTML, "base"); + (`HTML, "basefont"); + (`HTML, "bgsound"); + (`HTML, "blockquote"); + (`HTML, "body"); + (`HTML, "br"); + (`HTML, "button"); + (`HTML, "caption"); + (`HTML, "center"); + (`HTML, "col"); + (`HTML, "colgroup"); + (`HTML, "dd"); + (`HTML, "details"); + (`HTML, "dir"); + (`HTML, "div"); + (`HTML, "dl"); + (`HTML, "dt"); + (`HTML, "embed"); + (`HTML, "fieldset"); + (`HTML, "figcaption"); + (`HTML, "figure"); + (`HTML, "footer"); + (`HTML, "form"); + (`HTML, "frame"); + (`HTML, "frameset"); + (`HTML, "h1"); + (`HTML, "h2"); + (`HTML, "h3"); + (`HTML, "h4"); + (`HTML, "h5"); + (`HTML, "h6"); + (`HTML, "head"); + (`HTML, "header"); + (`HTML, "hgroup"); + (`HTML, "hr"); + (`HTML, "html"); + (`HTML, "iframe"); + (`HTML, "img"); + (`HTML, "input"); + (`HTML, "isindex"); + (`HTML, "li"); + (`HTML, "link"); + (`HTML, "listing"); + (`HTML, "main"); + (`HTML, "marquee"); + (`HTML, "meta"); + (`HTML, "nav"); + (`HTML, "noembed"); + (`HTML, "noframes"); + (`HTML, "noscript"); + (`HTML, "object"); + (`HTML, "ol"); + (`HTML, "p"); + (`HTML, "param"); + (`HTML, "plaintext"); + (`HTML, "pre"); + (`HTML, "script"); + (`HTML, "section"); + (`HTML, "select"); + (`HTML, "source"); + (`HTML, "style"); + (`HTML, "summary"); + (`HTML, "table"); + (`HTML, "tbody"); + (`HTML, "td"); + (`HTML, "template"); + (`HTML, "textarea"); + (`HTML, "tfoot"); + (`HTML, "th"); + (`HTML, "thead"); + (`HTML, "title"); + (`HTML, "tr"); + (`HTML, "track"); + (`HTML, "ul"); + (`HTML, "wbr"); + (`HTML, "xmp"); + (`MathML, "mi"); + (`MathML, "mo"); + (`MathML, "mn"); + (`MathML, "ms"); + (`MathML, "mtext"); + (`MathML, "annotation-xml"); + (`SVG, "foreignObject"); + (`SVG, "desc"); + (`SVG, "title"); + ] let is_not_hidden tag = - tag.Token_tag.attributes |> List.exists (fun (name, value) -> - name = "type" && value <> "hidden") + tag.Token_tag.attributes + |> List.exists (fun (name, value) -> name = "type" && value <> "hidden") end - - (* Context detection. *) type simple_context = [ `Document | `Fragment of string ] type context = [ `Document | `Fragment of qname ] -module Context : -sig +module Context : sig type t val uninitialized : unit -> t - val initialize : - [< simple_context ] -> - t -> - unit cps - + val initialize : [< simple_context ] -> t -> unit cps val the_context : t -> context val element : t -> element option val token : t -> string option -end = -struct +end = struct let detect tokens throw k = let tokens, restore = checkpoint tokens in let last_name = ref None in let next_token k = next_expected tokens throw (fun token -> - begin match token with - | _, `Start {name} -> last_name := Some name - | _ -> () - end; - k token) + begin match token with + | _, `Start { name } -> last_name := Some name + | _ -> () + end; + k token) in - let k context = restore (); k (context, !last_name) in + let k context = + restore (); + k (context, !last_name) + in let rec scan () = next_token begin function - | _, `Doctype _ -> k `Document - | _, `String s when not @@ is_whitespace_only s -> k (`Fragment "body") - | _, `String _ -> scan () - | _, `Char c when not @@ is_whitespace c -> k (`Fragment "body") - | _, `Char _ -> scan () - | _, `EOF -> k (`Fragment "body") - | _, `Start {name = "html"} -> k `Document - | _, `Start {name = "head" | "body" | "frameset"} -> - k (`Fragment "html") - | _, `Start {name = - "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | - "style" | "template" | "title"} -> - k (`Fragment "head") - | _, `Start {name = "frame"} -> k (`Fragment "frameset") - | _, `Start {name = "li"} -> k (`Fragment "ul") - | _, `Start {name = - "caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead"} -> - k (`Fragment "table") - | _, `Start {name = "tr"} -> k (`Fragment "tbody") - | _, `Start {name = "td" | "th"} -> k (`Fragment "tr") - | _, `Start {name = "optgroup" | "option"} -> k (`Fragment "select") - | _, `Start {name = - "altglyph" | "altglyphdef" | "altglyphitem" | "animate" | - "animatecolor" | "animatemotion" | "animatetransform" | "circle" | - "clippath" | "color-profile" | "cursor" | "defs" | "desc" | - "ellipse" | "feblend" | "fecolormatrix" | "fecomponenttransfer" | - "fecomposite" | "fediffuselighting" | "fedisplacementmap" | - "fedistantlight" | "feflood" | "fefunca" | "fefuncb" | "fefuncg" | - "fefuncr" | "fegaussianblur" | "feimage" | "femerge" | - "femergenode" | "femorphology" | "feoffset" | "fepointlight" | - "fespecularlighting" | "fespotlight" | "fetile" | "feturbulence" | - "filter" | "font-face" | "font-face-format" | "font-face-name" | - "font-face-src" | "font-face-uri" | "foreignobject" | "g" | - "glyph" | "glyphref" | "hkern" | "image" | "line" | - "lineargradient" | "marker" | "mask" | "metadata" | - "missing-glyph" | "mpath" | "path" | "pattern" | "polygon" | - "polyline" | "radialgradient" | "rect" | "set" | "stop" | "switch" | - "symbol" | "text" | "textpath" | "tref" | "tspan" | "use"} -> - k (`Fragment "svg") - | _, `Start {name = - "maction" | "maligngroup" | "malignmark" | "menclose" | "merror" | - "mfenced" | "mfrac" | "mglyph" | "mi" | "mlabeledtr" | "mlongdiv" | - "mmultiscripts" | "mn" | "mo" | "mover" | "mpadded" | "mphantom" | - "mroot" | "mrow" | "ms" | "mscarries" | "mscarry" | "msgroup" | - "msline" | "mspace" | "msqrt" | "msrow" | "mstack" | "mstyle" | - "msub" | "msup" | "msubsup" | "mtable" | "mtd" | "mtext" | "mtr" | - "munder" | "munderover" | "semantics" | "annotation" | - "annotation-xml"} -> - k (`Fragment "math") - | _, `Start _ -> k (`Fragment "body") - | _, (`End _ | `Comment _) -> scan () - end + | _, `Doctype _ -> k `Document + | _, `String s when not @@ is_whitespace_only s -> + k (`Fragment "body") + | _, `String _ -> scan () + | _, `Char c when not @@ is_whitespace c -> k (`Fragment "body") + | _, `Char _ -> scan () + | _, `EOF -> k (`Fragment "body") + | _, `Start { name = "html" } -> k `Document + | _, `Start { name = "head" | "body" | "frameset" } -> + k (`Fragment "html") + | ( _, + `Start + { + name = + ( "base" | "basefont" | "bgsound" | "link" | "meta" + | "noframes" | "style" | "template" | "title" ); + } ) -> + k (`Fragment "head") + | _, `Start { name = "frame" } -> k (`Fragment "frameset") + | _, `Start { name = "li" } -> k (`Fragment "ul") + | ( _, + `Start + { + name = + "caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead"; + } ) -> + k (`Fragment "table") + | _, `Start { name = "tr" } -> k (`Fragment "tbody") + | _, `Start { name = "td" | "th" } -> k (`Fragment "tr") + | _, `Start { name = "optgroup" | "option" } -> k (`Fragment "select") + | ( _, + `Start + { + name = + ( "altglyph" | "altglyphdef" | "altglyphitem" | "animate" + | "animatecolor" | "animatemotion" | "animatetransform" + | "circle" | "clippath" | "color-profile" | "cursor" + | "defs" | "desc" | "ellipse" | "feblend" | "fecolormatrix" + | "fecomponenttransfer" | "fecomposite" + | "fediffuselighting" | "fedisplacementmap" + | "fedistantlight" | "feflood" | "fefunca" | "fefuncb" + | "fefuncg" | "fefuncr" | "fegaussianblur" | "feimage" + | "femerge" | "femergenode" | "femorphology" | "feoffset" + | "fepointlight" | "fespecularlighting" | "fespotlight" + | "fetile" | "feturbulence" | "filter" | "font-face" + | "font-face-format" | "font-face-name" | "font-face-src" + | "font-face-uri" | "foreignobject" | "g" | "glyph" + | "glyphref" | "hkern" | "image" | "line" | "lineargradient" + | "marker" | "mask" | "metadata" | "missing-glyph" | "mpath" + | "path" | "pattern" | "polygon" | "polyline" + | "radialgradient" | "rect" | "set" | "stop" | "switch" + | "symbol" | "text" | "textpath" | "tref" | "tspan" | "use" + ); + } ) -> + k (`Fragment "svg") + | ( _, + `Start + { + name = + ( "maction" | "maligngroup" | "malignmark" | "menclose" + | "merror" | "mfenced" | "mfrac" | "mglyph" | "mi" + | "mlabeledtr" | "mlongdiv" | "mmultiscripts" | "mn" | "mo" + | "mover" | "mpadded" | "mphantom" | "mroot" | "mrow" | "ms" + | "mscarries" | "mscarry" | "msgroup" | "msline" | "mspace" + | "msqrt" | "msrow" | "mstack" | "mstyle" | "msub" | "msup" + | "msubsup" | "mtable" | "mtd" | "mtext" | "mtr" | "munder" + | "munderover" | "semantics" | "annotation" + | "annotation-xml" ); + } ) -> + k (`Fragment "math") + | _, `Start _ -> k (`Fragment "body") + | _, (`End _ | `Comment _) -> scan () + end in scan () @@ -237,155 +311,159 @@ struct (fun k -> match requested_context with | `Fragment element -> - (* HTML element names are case-insensitive, even in foreign content. + (* HTML element names are case-insensitive, even in foreign content. Lowercase the element name given by the user before analysis by the parser, to match this convention. [String.lowercase] is acceptable here because the API assumes the string [element] is in UTF-8. *) - k (`Fragment (String.lowercase_ascii element), None) + k (`Fragment (String.lowercase_ascii element), None) | `Document as c -> k (c, None)) - (fun (detected_context, deciding_token) -> - - let context = - match detected_context with - | `Document -> `Document - | `Fragment "math" -> `Fragment (`MathML, "math") - | `Fragment "svg" -> `Fragment (`SVG, "svg") - | `Fragment name -> `Fragment (`HTML, name) - in + (fun (detected_context, deciding_token) -> + let context = + match detected_context with + | `Document -> `Document + | `Fragment "math" -> `Fragment (`MathML, "math") + | `Fragment "svg" -> `Fragment (`SVG, "svg") + | `Fragment name -> `Fragment (`HTML, name) + in - let context_element = - match context with - | `Document -> None - | `Fragment name -> - let is_html_integration_point = - match name with - | `SVG, ("foreignObject" | "desc" | "title") -> true - | _ -> false - in + let context_element = + match context with + | `Document -> None + | `Fragment name -> + let is_html_integration_point = + match name with + | `SVG, ("foreignObject" | "desc" | "title") -> true + | _ -> false + in - Some (Element.create - ~is_html_integration_point ~suppress:true name (1, 1)) - in + Some + (Element.create ~is_html_integration_point ~suppress:true name + (1, 1)) + in - state := context, context_element, deciding_token; + state := (context, context_element, deciding_token); - k ()) + k ()) - let the_context {contents = (c, _, _)} = c - let element {contents = (_, e, _)} = e - let token {contents = (_, _, t)} = t + let the_context { contents = c, _, _ } = c + let element { contents = _, e, _ } = e + let token { contents = _, _, t } = t end - - (* Heplers for foreign content. *) -module Foreign : -sig +module Foreign : sig val is_mathml_text_integration_point : qname -> bool - val is_html_integration_point : - ns -> string -> (string * string) list -> bool + val is_html_integration_point : ns -> string -> (string * string) list -> bool val adjust_mathml_attributes : ((string * string) * string) list -> ((string * string) * string) list + val adjust_svg_attributes : ((string * string) * string) list -> ((string * string) * string) list + val adjust_svg_tag_name : string -> string -end = -struct +end = struct let is_mathml_text_integration_point qname = list_mem_qname qname - [`MathML, "mi"; `MathML, "mo"; `MathML, "mn"; `MathML, "ms"; - `MathML, "mtext"] + [ + (`MathML, "mi"); + (`MathML, "mo"); + (`MathML, "mn"); + (`MathML, "ms"); + (`MathML, "mtext"); + ] let is_html_integration_point namespace tag_name attributes = match namespace with | `HTML | `Other _ -> false | `MathML -> - tag_name = "annotation-xml" && - attributes |> List.exists (function - | "encoding", "text/html" -> true - | "encoding", "application/xhtml+xml" -> true - | _ -> false) - | `SVG -> - list_mem_string tag_name ["foreignObject"; "desc"; "title"] + tag_name = "annotation-xml" + && attributes + |> List.exists (function + | "encoding", "text/html" -> true + | "encoding", "application/xhtml+xml" -> true + | _ -> false) + | `SVG -> list_mem_string tag_name [ "foreignObject"; "desc"; "title" ] let adjust_mathml_attributes attributes = - attributes |> List.map (fun ((ns, name), value) -> - let name = - if ns = mathml_ns && name = "definitionurl" then "definitionURL" - else name - in - (ns, name), value) + attributes + |> List.map (fun ((ns, name), value) -> + let name = + if ns = mathml_ns && name = "definitionurl" then "definitionURL" + else name + in + ((ns, name), value)) let adjust_svg_attributes attributes = - attributes |> List.map (fun ((ns, name), value) -> - let name = - match name with - | "attributename" -> "attributeName" - | "attributetype" -> "attributeType" - | "basefrequency" -> "baseFrequency" - | "baseprofile" -> "baseProfile" - | "calcmode" -> "calcMode" - | "clippathunits" -> "clipPathUnits" - | "contentscripttype" -> "contentScriptType" - | "contentstyletype" -> "contentStyleType" - | "diffuseconstant" -> "diffuseConstant" - | "edgemode" -> "edgeMode" - | "externalresourcesrequired" -> "externalResourcesRequired" - | "filterres" -> "filterRes" - | "filterunits" -> "filterUnits" - | "glyphref" -> "glyphRef" - | "gradienttransform" -> "gradientTransform" - | "gradientunits" -> "gradientUnits" - | "kernelmatrix" -> "kernelMatrix" - | "kernelunitlength" -> "kernelUnitLength" - | "keypoints" -> "keyPoints" - | "keysplines" -> "keySplines" - | "keytimes" -> "keyTimes" - | "lengthadjust" -> "lengthAdjust" - | "limitingconeangle" -> "limitingConeAngle" - | "markerheight" -> "markerHeight" - | "markerunits" -> "markerUnits" - | "markerwidth" -> "markerWidth" - | "maskcontentunits" -> "maskContentUnits" - | "maskunits" -> "maskUnits" - | "numoctaves" -> "numOctaves" - | "pathlength" -> "pathLength" - | "patterncontentunits" -> "patternContentUnits" - | "patterntransform" -> "patternTransform" - | "patternunits" -> "patternUnits" - | "pointsatx" -> "pointsAtX" - | "pointsaty" -> "pointsAtY" - | "pointsatz" -> "pointsAtZ" - | "preservealpha" -> "preserveAlpha" - | "preserveaspectratio" -> "preserveAspectRatio" - | "primitiveunits" -> "primitiveUnits" - | "refx" -> "refX" - | "refy" -> "refY" - | "repeatcount" -> "repeatCount" - | "repeatdur" -> "repeatDur" - | "requiredextensions" -> "requiredExtensions" - | "requiredfeatures" -> "requiredFeatures" - | "specularconstant" -> "specularConstant" - | "specularexponent" -> "specularExponent" - | "spreadmethod" -> "spreadMethod" - | "startoffset" -> "startOffset" - | "stddeviation" -> "stdDeviation" - | "stitchtiles" -> "stitchTiles" - | "surfacescale" -> "surfaceScale" - | "systemlanguage" -> "systemLanguage" - | "tablevalues" -> "tableValues" - | "targetx" -> "targetX" - | "targety" -> "targetY" - | "textlength" -> "textLength" - | "viewbox" -> "viewBox" - | "viewtarget" -> "viewTarget" - | "xchannelselector" -> "xChannelSelector" - | "ychannelselector" -> "yChannelSelector" - | "zoomandpan" -> "zoomAndPan" - | _ -> name - in - (ns, name), value) + attributes + |> List.map (fun ((ns, name), value) -> + let name = + match name with + | "attributename" -> "attributeName" + | "attributetype" -> "attributeType" + | "basefrequency" -> "baseFrequency" + | "baseprofile" -> "baseProfile" + | "calcmode" -> "calcMode" + | "clippathunits" -> "clipPathUnits" + | "contentscripttype" -> "contentScriptType" + | "contentstyletype" -> "contentStyleType" + | "diffuseconstant" -> "diffuseConstant" + | "edgemode" -> "edgeMode" + | "externalresourcesrequired" -> "externalResourcesRequired" + | "filterres" -> "filterRes" + | "filterunits" -> "filterUnits" + | "glyphref" -> "glyphRef" + | "gradienttransform" -> "gradientTransform" + | "gradientunits" -> "gradientUnits" + | "kernelmatrix" -> "kernelMatrix" + | "kernelunitlength" -> "kernelUnitLength" + | "keypoints" -> "keyPoints" + | "keysplines" -> "keySplines" + | "keytimes" -> "keyTimes" + | "lengthadjust" -> "lengthAdjust" + | "limitingconeangle" -> "limitingConeAngle" + | "markerheight" -> "markerHeight" + | "markerunits" -> "markerUnits" + | "markerwidth" -> "markerWidth" + | "maskcontentunits" -> "maskContentUnits" + | "maskunits" -> "maskUnits" + | "numoctaves" -> "numOctaves" + | "pathlength" -> "pathLength" + | "patterncontentunits" -> "patternContentUnits" + | "patterntransform" -> "patternTransform" + | "patternunits" -> "patternUnits" + | "pointsatx" -> "pointsAtX" + | "pointsaty" -> "pointsAtY" + | "pointsatz" -> "pointsAtZ" + | "preservealpha" -> "preserveAlpha" + | "preserveaspectratio" -> "preserveAspectRatio" + | "primitiveunits" -> "primitiveUnits" + | "refx" -> "refX" + | "refy" -> "refY" + | "repeatcount" -> "repeatCount" + | "repeatdur" -> "repeatDur" + | "requiredextensions" -> "requiredExtensions" + | "requiredfeatures" -> "requiredFeatures" + | "specularconstant" -> "specularConstant" + | "specularexponent" -> "specularExponent" + | "spreadmethod" -> "spreadMethod" + | "startoffset" -> "startOffset" + | "stddeviation" -> "stdDeviation" + | "stitchtiles" -> "stitchTiles" + | "surfacescale" -> "surfaceScale" + | "systemlanguage" -> "systemLanguage" + | "tablevalues" -> "tableValues" + | "targetx" -> "targetX" + | "targety" -> "targetY" + | "textlength" -> "textLength" + | "viewbox" -> "viewBox" + | "viewtarget" -> "viewTarget" + | "xchannelselector" -> "xChannelSelector" + | "ychannelselector" -> "yChannelSelector" + | "zoomandpan" -> "zoomAndPan" + | _ -> name + in + ((ns, name), value)) let adjust_svg_tag_name = function | "altglyph" -> "altGlyph" @@ -428,24 +506,18 @@ struct | s -> s end - - (* Stack of open elements. *) -module Stack : -sig - type t = (element list ref * int) +module Stack : sig + type t = element list ref * int val create : ?limit:int -> unit -> t val elements : t -> element list ref - val current_element : t -> element option val require_current_element : t -> element val adjusted_current_element : Context.t -> t -> element option val current_element_is : t -> string list -> bool val current_element_is_foreign : Context.t -> t -> bool - val has : t -> string -> bool - val in_scope : t -> string -> bool val in_button_scope : t -> string -> bool val in_list_item_scope : t -> string -> bool @@ -454,23 +526,19 @@ sig val one_in_scope : t -> string list -> bool val one_in_table_scope : t -> string list -> bool val target_in_scope : t -> element -> bool - val remove : t -> element -> unit val replace : t -> old:element -> new_:element -> unit val insert_below : t -> anchor:element -> new_:element -> unit -end = -struct - type t = (element list ref * int) - (** The Adoption Agency algorithm sometimes push too many elements when trying to recover - from malformed HTMLs. Most of the time such HTML *) +end = struct + type t = element list ref * int + (** The Adoption Agency algorithm sometimes push too many elements when trying + to recover from malformed HTMLs. Most of the time such HTML *) - let create ?(limit=Int.max_int) () = (ref [], limit) + let create ?(limit = Int.max_int) () = (ref [], limit) let elements (el, _) = el let current_element (open_elements, _) = - match !open_elements with - | [] -> None - | element::_ -> Some element + match !open_elements with [] -> None | element :: _ -> Some element let require_current_element t = match current_element t with @@ -478,67 +546,78 @@ struct | Some element -> element let adjusted_current_element context (open_elements, _) = - match !open_elements, Context.element context with - | [_], Some element -> Some element + match (!open_elements, Context.element context) with + | [ _ ], Some element -> Some element | [], _ -> None - | element::_, _ -> Some element + | element :: _, _ -> Some element let current_element_is (open_elements, _) names = match !open_elements with - | {element_name = `HTML, name}::_ -> list_mem_string name names + | { element_name = `HTML, name } :: _ -> list_mem_string name names | _ -> false let current_element_is_foreign context t = match adjusted_current_element context t with - | Some {element_name = ns, _} when ns <> `HTML -> true + | Some { element_name = ns, _ } when ns <> `HTML -> true | _ -> false let has (open_elements, _) name = List.exists - (fun {element_name = ns, name'} -> - ns = `HTML && name' = name) !open_elements + (fun { element_name = ns, name' } -> ns = `HTML && name' = name) + !open_elements let in_scope_general scope_delimiters (open_elements, depth_limit) name' = let rec scan depth = function | [] -> false | _ when depth = 0 -> failwith "in_scope_general: depth limit reached" - | {element_name = ns, name'' as name}::more -> - if ns = `HTML && name'' = name' then true - else - if list_mem_qname name scope_delimiters then false - else scan (depth-1) more + | { element_name = (ns, name'') as name } :: more -> + if ns = `HTML && name'' = name' then true + else if list_mem_qname name scope_delimiters then false + else scan (depth - 1) more in scan depth_limit !open_elements let scope_delimiters = - [`HTML, "applet"; `HTML, "caption"; `HTML, "html"; - `HTML, "table"; `HTML, "td"; `HTML, "th"; - `HTML, "marquee"; `HTML, "object"; `HTML, "template"; - `MathML, "mi"; `MathML, "mo"; `MathML, "mn"; - `MathML, "ms"; `MathML, "mtext"; `MathML, "annotation-xml"; - `SVG, "foreignObject"; `SVG, "desc"; `SVG, "title"] + [ + (`HTML, "applet"); + (`HTML, "caption"); + (`HTML, "html"); + (`HTML, "table"); + (`HTML, "td"); + (`HTML, "th"); + (`HTML, "marquee"); + (`HTML, "object"); + (`HTML, "template"); + (`MathML, "mi"); + (`MathML, "mo"); + (`MathML, "mn"); + (`MathML, "ms"); + (`MathML, "mtext"); + (`MathML, "annotation-xml"); + (`SVG, "foreignObject"); + (`SVG, "desc"); + (`SVG, "title"); + ] let in_scope = in_scope_general scope_delimiters - - let in_button_scope = in_scope_general ((`HTML, "button")::scope_delimiters) + let in_button_scope = in_scope_general ((`HTML, "button") :: scope_delimiters) let in_list_item_scope = - in_scope_general ((`HTML, "ol")::(`HTML, "ul")::scope_delimiters) + in_scope_general ((`HTML, "ol") :: (`HTML, "ul") :: scope_delimiters) let in_table_scope = - in_scope_general [`HTML, "html"; `HTML, "table"; `HTML, "template"] + in_scope_general [ (`HTML, "html"); (`HTML, "table"); (`HTML, "template") ] let in_select_scope (open_elements, depth_limit) name = let rec scan depth = function | [] -> false | _ when depth = 0 -> failwith "in_select_scope: depth limit reached" - | {element_name = ns, name'}::more -> - if ns <> `HTML then false - else - if name' = name then true - else - if name' = "optgroup" || name' = "option" then scan (depth-1) more - else false + | { element_name = ns, name' } :: more -> + if ns <> `HTML then false + else if name' = name then true + else if name' = "optgroup" || name' = "option" then + scan (depth - 1) more + else false in scan depth_limit !open_elements @@ -546,11 +625,10 @@ struct let rec scan depth = function | [] -> false | _ when depth = 0 -> failwith "one_in_scope: depth limit reached" - | {element_name = ns, name' as name}::more -> - if ns = `HTML && list_mem_string name' names then true - else - if list_mem_qname name scope_delimiters then false - else scan (depth-1) more + | { element_name = (ns, name') as name } :: more -> + if ns = `HTML && list_mem_string name' names then true + else if list_mem_qname name scope_delimiters then false + else scan (depth - 1) more in scan depth_limit !open_elements @@ -558,13 +636,13 @@ struct let rec scan depth = function | [] -> false | _ when depth = 0 -> failwith "one_in_table_scope: depth limit reached" - | {element_name = ns, name' as name}::more -> - if ns = `HTML && list_mem_string name' names then true - else - if list_mem_qname name - [`HTML, "html"; `HTML, "table"; `HTML, "template"] then - false - else scan (depth-1) more + | { element_name = (ns, name') as name } :: more -> + if ns = `HTML && list_mem_string name' names then true + else if + list_mem_qname name + [ (`HTML, "html"); (`HTML, "table"); (`HTML, "template") ] + then false + else scan (depth - 1) more in scan depth_limit !open_elements @@ -572,141 +650,129 @@ struct let rec scan depth = function | [] -> false | _ when depth = 0 -> failwith "target_in_scope: depth limit reached" - | e::more -> - if e == node then true - else - if list_mem_qname node.element_name scope_delimiters then false - else scan (depth-1) more + | e :: more -> + if e == node then true + else if list_mem_qname node.element_name scope_delimiters then false + else scan (depth - 1) more in scan depth_limit !open_elements let remove (open_elements, _) element = - open_elements := List.filter ((!=) element) !open_elements; + open_elements := List.filter (( != ) element) !open_elements; element.is_open <- false let replace (open_elements, _) ~old ~new_ = open_elements := - List.map (fun e -> - if e == old then (e.is_open <- false; new_) else e) !open_elements + List.map + (fun e -> + if e == old then ( + e.is_open <- false; + new_) + else e) + !open_elements let insert_below (open_elements, _) ~anchor ~new_ = let rec insert prefix = function | [] -> List.rev prefix - | e::more when e == anchor -> List.rev_append prefix @@ new_::e::more - | e::more -> insert (e::prefix) more + | e :: more when e == anchor -> + List.rev_append prefix @@ (new_ :: e :: more) + | e :: more -> insert (e :: prefix) more in open_elements := insert [] !open_elements end - - (* List of active formatting elements. *) -module Active : -sig - type entry = - | Marker - | Element_ of element * location * Token_tag.t - +module Active : sig + type entry = Marker | Element_ of element * location * Token_tag.t type t = entry list ref val create : unit -> t - val add_marker : t -> unit val clear_until_marker : t -> unit - val has : t -> element -> bool val remove : t -> element -> unit val replace : t -> old:element -> new_:element -> unit val insert_after : t -> anchor:element -> new_:element -> unit - val has_before_marker : t -> string -> element option -end = -struct - type entry = - | Marker - | Element_ of element * location * Token_tag.t - +end = struct + type entry = Marker | Element_ of element * location * Token_tag.t type t = entry list ref let create () = ref [] let add_marker active_formatting_elements = - active_formatting_elements := Marker::!active_formatting_elements + active_formatting_elements := Marker :: !active_formatting_elements let clear_until_marker active_formatting_elements = let rec iterate = function - | Marker::rest -> rest - | (Element_ _)::rest -> iterate rest + | Marker :: rest -> rest + | Element_ _ :: rest -> iterate rest | [] -> [] in active_formatting_elements := iterate !active_formatting_elements let has active_formatting_elements element = - !active_formatting_elements |> List.exists (function + !active_formatting_elements + |> List.exists (function | Element_ (e, _, _) when e == element -> true | _ -> false) let remove active_formatting_elements element = active_formatting_elements := - !active_formatting_elements |> List.filter (function + !active_formatting_elements + |> List.filter (function | Element_ (e, _, _) when e == element -> false | _ -> true) let replace active_formatting_elements ~old ~new_ = active_formatting_elements := - !active_formatting_elements |> List.map (function + !active_formatting_elements + |> List.map (function | Element_ (e, l, t) when e == old -> Element_ (new_, l, t) | e -> e) let insert_after active_formatting_elements ~anchor ~new_ = let rec insert prefix = function | [] -> List.rev prefix - | (Element_ (e, l, t) as v)::more when e == anchor -> - let new_entry = Element_ (new_, l, t) in - List.rev_append prefix (v::new_entry::more) - | v::more -> insert (v::prefix) more + | (Element_ (e, l, t) as v) :: more when e == anchor -> + let new_entry = Element_ (new_, l, t) in + List.rev_append prefix (v :: new_entry :: more) + | v :: more -> insert (v :: prefix) more in active_formatting_elements := insert [] !active_formatting_elements let has_before_marker active_formatting_elements name = let rec scan = function - | [] | Marker::_ -> None - | Element_ (n, _, _)::_ when n.element_name = (`HTML, name) -> Some n - | _::more -> scan more + | [] | Marker :: _ -> None + | Element_ (n, _, _) :: _ when n.element_name = (`HTML, name) -> Some n + | _ :: more -> scan more in scan !active_formatting_elements end - - type mode = unit -> unit (* Stack of template insertion modes. *) -module Template : -sig +module Template : sig type t = mode list ref val create : unit -> t - val push : t -> mode -> unit val pop : t -> unit -end = -struct +end = struct type t = (unit -> unit) list ref let create () = ref [] let push template_insertion_modes mode = - template_insertion_modes := mode::!template_insertion_modes + template_insertion_modes := mode :: !template_insertion_modes let pop template_insertion_modes = match !template_insertion_modes with | [] -> () - | _::rest -> template_insertion_modes := rest + | _ :: rest -> template_insertion_modes := rest end - - (* Subtree buffers. HTML specifies the "adoption agency algorithm" for recovering from certain kinds of errors. This algorithm is (apparently) incompatible with streaming parsers that do not maintain a DOM - such as @@ -719,63 +785,54 @@ end practice, this means that buffering begins when a formatting element is encountered, and ends when the parent of the formatting element is popped off the open element stack. *) -module Subtree : -sig +module Subtree : sig type t val create : Stack.t -> t - val accumulate : t -> location -> signal -> bool - val enable : t -> unit val disable : t -> (location * signal) list val adoption_agency_algorithm : t -> Active.t -> location -> string -> bool * (location * Error.t) list -end = -struct - type t = - {open_elements : Stack.t; - mutable enabled : bool; - mutable position : element} +end = struct + type t = { + open_elements : Stack.t; + mutable enabled : bool; + mutable position : element; + } let create open_elements = - {open_elements; - enabled = false; - position = Element.dummy} + { open_elements; enabled = false; position = Element.dummy } let accumulate subtree_buffer l s = if not subtree_buffer.enabled then true else begin begin match s with | `Start_element (_, attributes) -> - let parent = subtree_buffer.position in - let child = - Stack.require_current_element subtree_buffer.open_elements in - - child.attributes <- attributes; - child.parent <- parent; - parent.children <- (l, Element child)::parent.children; + let parent = subtree_buffer.position in + let child = + Stack.require_current_element subtree_buffer.open_elements + in - subtree_buffer.position <- child + child.attributes <- attributes; + child.parent <- parent; + parent.children <- (l, Element child) :: parent.children; + subtree_buffer.position <- child | `End_element -> - subtree_buffer.position.end_location <- l; - subtree_buffer.position <- - Stack.require_current_element subtree_buffer.open_elements - + subtree_buffer.position.end_location <- l; + subtree_buffer.position <- + Stack.require_current_element subtree_buffer.open_elements | `Text ss -> - subtree_buffer.position.children <- - (l, Text ss)::subtree_buffer.position.children - + subtree_buffer.position.children <- + (l, Text ss) :: subtree_buffer.position.children | `PI (t, s) -> - subtree_buffer.position.children <- - (l, PI (t, s))::subtree_buffer.position.children - + subtree_buffer.position.children <- + (l, PI (t, s)) :: subtree_buffer.position.children | `Comment s -> - subtree_buffer.position.children <- - (l, Comment s)::subtree_buffer.position.children - + subtree_buffer.position.children <- + (l, Comment s) :: subtree_buffer.position.children | `Xml _ | `Doctype _ -> () end; @@ -788,28 +845,27 @@ struct match Stack.current_element subtree_buffer.open_elements with | None -> () | Some element -> - element.buffering <- true; - subtree_buffer.position <- element; - subtree_buffer.enabled <- true + element.buffering <- true; + subtree_buffer.position <- element; + subtree_buffer.enabled <- true let disable subtree_buffer = - let (_, depth_limit) = subtree_buffer.open_elements in + let _, depth_limit = subtree_buffer.open_elements in let rec traverse depth acc = function | _ when depth = 0 -> failwith "Subtree.disable: depth limit reached" - | l, Element {element_name; attributes; end_location; children} -> - let name = Ns.to_string (fst element_name), snd element_name in - let start_signal = l, `Start_element (name, attributes) in - let end_signal = end_location, `End_element in - start_signal::(List.fold_left (traverse (depth-1)) (end_signal::acc) children) - - | l, Text ss -> - begin match acc with - | (_, `Text ss')::rest -> (l, `Text (ss @ ss'))::rest - | _ -> (l, `Text ss)::acc + | l, Element { element_name; attributes; end_location; children } -> + let name = (Ns.to_string (fst element_name), snd element_name) in + let start_signal = (l, `Start_element (name, attributes)) in + let end_signal = (end_location, `End_element) in + start_signal + :: List.fold_left (traverse (depth - 1)) (end_signal :: acc) children + | l, Text ss -> begin + match acc with + | (_, `Text ss') :: rest -> (l, `Text (ss @ ss')) :: rest + | _ -> (l, `Text ss) :: acc end - - | l, PI (t, s) -> (l, `PI (t, s))::acc - | l, Comment s -> (l, `Comment s)::acc + | l, PI (t, s) -> (l, `PI (t, s)) :: acc + | l, Comment s -> (l, `Comment s) :: acc in let result = @@ -822,16 +878,15 @@ struct result (* Part of 8.2.5.4.7. *) - let adoption_agency_algorithm - subtree_buffer active_formatting_elements l subject = - - let (open_elements, _) as stack = subtree_buffer.open_elements in + let adoption_agency_algorithm subtree_buffer active_formatting_elements l + subject = + let ((open_elements, _) as stack) = subtree_buffer.open_elements in let above_removed_nodes = ref [] in let rec above_in_stack node = function - | e::e'::_ when e == node -> e' - | _::more -> above_in_stack node more + | e :: e' :: _ when e == node -> e' + | _ :: more -> above_in_stack node more | [] -> failwith "above_in_stack: not found" in @@ -844,7 +899,7 @@ struct let remove_node node = above_removed_nodes := - (node, above_in_stack node !open_elements)::!above_removed_nodes; + (node, above_in_stack node !open_elements) :: !above_removed_nodes; Stack.remove stack node in @@ -853,16 +908,16 @@ struct let entry, filtered_children = let rec remove prefix = function - | (_, Element e as entry)::rest when e == node -> - entry, List.rev_append prefix rest - | e::rest -> remove (e::prefix) rest - | [] -> (node.location, Element node), old_parent.children + | ((_, Element e) as entry) :: rest when e == node -> + (entry, List.rev_append prefix rest) + | e :: rest -> remove (e :: prefix) rest + | [] -> ((node.location, Element node), old_parent.children) in remove [] old_parent.children in old_parent.children <- filtered_children; - new_parent.children <- entry::new_parent.children; + new_parent.children <- entry :: new_parent.children; node.parent <- new_parent in @@ -870,7 +925,7 @@ struct let rec repeat inner_loop_counter node last_node bookmark = let node = above_node node in - if node == formatting_element then last_node, bookmark + if node == formatting_element then (last_node, bookmark) else begin if inner_loop_counter > 3 then Active.remove active_formatting_elements node; @@ -881,7 +936,12 @@ struct end else begin let new_node = - {node with is_open = true; children = []; parent = Element.dummy} + { + node with + is_open = true; + children = []; + parent = Element.dummy; + } in node.end_location <- l; @@ -895,7 +955,6 @@ struct (if last_node == furthest_block then Some new_node else bookmark) end end - in repeat 1 furthest_block furthest_block None in @@ -903,10 +962,11 @@ struct let find_formatting_element () = let rec scan = function | [] -> None - | Active.Marker::_ -> None - | (Active.Element_ ({element_name = `HTML, n} as e, _, _))::_ - when n = subject -> Some e - | _::rest -> scan rest + | Active.Marker :: _ -> None + | Active.Element_ (({ element_name = `HTML, n } as e), _, _) :: _ + when n = subject -> + Some e + | _ :: rest -> scan rest in scan !active_formatting_elements in @@ -914,9 +974,9 @@ struct let find_furthest_block formatting_element = let rec scan furthest = function | [] -> furthest - | e::_ when e == formatting_element -> furthest - | e::more when Element.is_special e.element_name -> scan (Some e) more - | _::more -> scan furthest more + | e :: _ when e == formatting_element -> furthest + | e :: more when Element.is_special e.element_name -> scan (Some e) more + | _ :: more -> scan furthest more in scan None !open_elements in @@ -925,11 +985,11 @@ struct let rec pop () = match !open_elements with | [] -> () - | e::more -> - open_elements := more; - e.is_open <- false; - e.end_location <- l; - if e != formatting_element then pop () + | e :: more -> + open_elements := more; + e.is_open <- false; + e.end_location <- l; + if e != formatting_element then pop () in pop (); subtree_buffer.position <- Stack.require_current_element stack @@ -938,75 +998,80 @@ struct let rec outer_loop outer_loop_counter errors = let outer_loop_counter = outer_loop_counter + 1 in - if outer_loop_counter >= 8 then true, List.rev errors + if outer_loop_counter >= 8 then (true, List.rev errors) else begin match find_formatting_element () with - | None -> false, List.rev errors + | None -> (false, List.rev errors) | Some formatting_element -> - if not formatting_element.is_open then begin - Active.remove active_formatting_elements formatting_element; - true, List.rev ((l, `Unmatched_end_tag subject)::errors) - end - else begin - if not @@ Stack.target_in_scope stack - formatting_element then begin - true, List.rev ((l, `Unmatched_end_tag subject)::errors) + if not formatting_element.is_open then begin + Active.remove active_formatting_elements formatting_element; + (true, List.rev ((l, `Unmatched_end_tag subject) :: errors)) end else begin - let errors = - if Stack.require_current_element stack == - formatting_element then - errors - else (l, `Unmatched_end_tag subject)::errors - in - - match find_furthest_block formatting_element with - | None -> - pop_to_formatting_element formatting_element; - Active.remove active_formatting_elements formatting_element; - true, List.rev errors - - | Some furthest_block -> - formatting_element.end_location <- l; - - let common_ancestor = - above_in_stack formatting_element !open_elements in - - let last_node, bookmark = - inner_loop formatting_element furthest_block in - - reparent last_node common_ancestor; - - let new_node = - {formatting_element with - is_open = true; children = []; parent = Element.dummy} + if not @@ Stack.target_in_scope stack formatting_element then begin + (true, List.rev ((l, `Unmatched_end_tag subject) :: errors)) + end + else begin + let errors = + if Stack.require_current_element stack == formatting_element + then errors + else (l, `Unmatched_end_tag subject) :: errors in - new_node.children <- furthest_block.children; - furthest_block.children <- []; - new_node.children |> List.iter (function - | _, Element child -> child.parent <- new_node - | _ -> ()); - - reparent new_node furthest_block; - - begin match bookmark with + match find_furthest_block formatting_element with | None -> - Active.replace active_formatting_elements - ~old:formatting_element ~new_:new_node - | Some node -> - Active.remove active_formatting_elements formatting_element; - Active.insert_after - active_formatting_elements ~anchor:node ~new_:new_node - end; - - Stack.remove stack formatting_element; - Stack.insert_below - stack ~anchor:furthest_block ~new_:new_node; - - outer_loop outer_loop_counter errors + pop_to_formatting_element formatting_element; + Active.remove active_formatting_elements formatting_element; + (true, List.rev errors) + | Some furthest_block -> + formatting_element.end_location <- l; + + let common_ancestor = + above_in_stack formatting_element !open_elements + in + + let last_node, bookmark = + inner_loop formatting_element furthest_block + in + + reparent last_node common_ancestor; + + let new_node = + { + formatting_element with + is_open = true; + children = []; + parent = Element.dummy; + } + in + + new_node.children <- furthest_block.children; + furthest_block.children <- []; + new_node.children + |> List.iter (function + | _, Element child -> child.parent <- new_node + | _ -> ()); + + reparent new_node furthest_block; + + begin match bookmark with + | None -> + Active.replace active_formatting_elements + ~old:formatting_element ~new_:new_node + | Some node -> + Active.remove active_formatting_elements + formatting_element; + Active.insert_after active_formatting_elements + ~anchor:node ~new_:new_node + end; + + Stack.remove stack formatting_element; + Stack.insert_below stack ~anchor:furthest_block + ~new_:new_node; + + outer_loop outer_loop_counter errors + end end - end end in @@ -1017,13 +1082,11 @@ struct current_node.end_location <- l; subtree_buffer.position <- Stack.require_current_element stack; Active.remove active_formatting_elements current_node; - true, [] + (true, []) end else outer_loop 0 [] end - - let parse ?depth_limit requested_context report tokens = let context = Context.uninitialized () in let tokenizer_state = ref `Data in @@ -1045,9 +1108,13 @@ let parse ?depth_limit requested_context report tokens = let report_if = Error.report_if report in let unmatched_end_tag l name k = - report l (`Unmatched_end_tag name) !throw k in + report l (`Unmatched_end_tag name) !throw k + in let misnested_tag l t context_name k = - report l (`Misnested_tag (t.name, context_name, t.Token_tag.attributes)) !throw k in + report l + (`Misnested_tag (t.name, context_name, t.Token_tag.attributes)) + !throw k + in let open_elements = Stack.create ?limit:depth_limit () in let active_formatting_elements = Active.create () in @@ -1064,95 +1131,96 @@ let parse ?depth_limit requested_context report tokens = let report_if_stack_has_other_than names k = let rec iterate = function | [] -> k () - | {element_name = ns, name; location}::more -> - report_if (not (ns = `HTML && list_mem_string name names)) - location (fun () -> `Unmatched_start_tag name) !throw (fun () -> - iterate more) + | { element_name = ns, name; location } :: more -> + report_if + (not (ns = `HTML && list_mem_string name names)) + location + (fun () -> `Unmatched_start_tag name) + !throw + (fun () -> iterate more) in iterate !(Stack.elements open_elements) in let rec current_mode = ref initial_mode - and constructor throw_ k = Context.initialize requested_context context throw_ (fun () -> + let initial_tokenizer_state = + match Context.the_context context with + | `Fragment (`HTML, ("title" | "textarea")) -> `RCDATA + | `Fragment + (`HTML, ("style" | "xmp" | "iframe" | "noembed" | "noframes")) -> + `RAWTEXT + | `Fragment (`HTML, "script") -> `Script_data + | `Fragment (`HTML, "plaintext") -> `PLAINTEXT + | _ -> `Data + in - let initial_tokenizer_state = - match Context.the_context context with - | `Fragment (`HTML, ("title" | "textarea")) -> `RCDATA - | `Fragment - (`HTML, ("style" | "xmp" | "iframe" | "noembed" | "noframes")) -> - `RAWTEXT - | `Fragment (`HTML, "script") -> `Script_data - | `Fragment (`HTML, "plaintext") -> `PLAINTEXT - | _ -> `Data - in - - set_tokenizer_state initial_tokenizer_state; + set_tokenizer_state initial_tokenizer_state; - begin match Context.the_context context with - | `Document -> () - | `Fragment _ -> - let notional_root = - Element.create ~suppress:true (`HTML, "html") (1, 1) in - (Stack.elements open_elements) := [notional_root] - end; + begin match Context.the_context context with + | `Document -> () + | `Fragment _ -> + let notional_root = + Element.create ~suppress:true (`HTML, "html") (1, 1) + in + Stack.elements open_elements := [ notional_root ] + end; - begin match Context.the_context context with - | `Fragment (`HTML, "template") -> - Template.push template_insertion_modes in_template_mode - | _ -> () - end; + begin match Context.the_context context with + | `Fragment (`HTML, "template") -> + Template.push template_insertion_modes in_template_mode + | _ -> () + end; - (* The following is a deviation from conformance. The goal is to avoid + (* The following is a deviation from conformance. The goal is to avoid insertion of a element into a fragment beginning with a or element. *) - begin match Context.token context with - | Some ("body" | "frameset") -> head_seen := true - | _ -> () - end; - - current_mode := - begin match Context.the_context context with - | `Fragment _ -> reset_mode () - | `Document -> initial_mode - end; - - (fun throw_ e k -> - throw := throw_; - ended := e; - output := k; - !current_mode ()) - |> make - |> k) + begin match Context.token context with + | Some ("body" | "frameset") -> head_seen := true + | _ -> () + end; + current_mode := + begin match Context.the_context context with + | `Fragment _ -> reset_mode () + | `Document -> initial_mode + end; + + (fun throw_ e k -> + throw := throw_; + ended := e; + output := k; + !current_mode ()) + |> make |> k) (* 8.2.3.1. *) and reset_mode () = let rec iterate last = function - | [e] when not last && Context.the_context context <> `Document -> - begin match Context.the_context context with - | `Document -> assert false - | `Fragment name -> iterate true [{e with element_name = name}] + | [ e ] when (not last) && Context.the_context context <> `Document -> + begin + match Context.the_context context with + | `Document -> assert false + | `Fragment name -> iterate true [ { e with element_name = name } ] end - | {element_name = _, "select"}::ancestors -> - let rec iterate' = function - | [] -> in_select_mode - | {element_name = _, "template"}::_ -> in_select_mode - | {element_name = _, "table"}::_ -> in_select_in_table_mode - | _::ancestors -> iterate' ancestors - in - iterate' ancestors - | {element_name = _, ("tr" | "th")}::_::_ -> in_cell_mode - | {element_name = _, "tr"}::_ -> in_row_mode - | {element_name = _, ("tbody" | "thead" | "tfoot")}::_ -> - in_table_body_mode - | {element_name = _, "caption"}::_ -> in_caption_mode - | {element_name = _, "colgroup"}::_ -> in_column_group_mode - | {element_name = _, "table"}::_ -> in_table_mode - | {element_name = _, "template"}::_ -> - begin match !template_insertion_modes with - | [] -> initial_mode (* This is an internal error, actually. *) - | mode::_ -> mode + | { element_name = _, "select" } :: ancestors -> + let rec iterate' = function + | [] -> in_select_mode + | { element_name = _, "template" } :: _ -> in_select_mode + | { element_name = _, "table" } :: _ -> in_select_in_table_mode + | _ :: ancestors -> iterate' ancestors + in + iterate' ancestors + | { element_name = _, ("tr" | "th") } :: _ :: _ -> in_cell_mode + | { element_name = _, "tr" } :: _ -> in_row_mode + | { element_name = _, ("tbody" | "thead" | "tfoot") } :: _ -> + in_table_body_mode + | { element_name = _, "caption" } :: _ -> in_caption_mode + | { element_name = _, "colgroup" } :: _ -> in_column_group_mode + | { element_name = _, "table" } :: _ -> in_table_mode + | { element_name = _, "template" } :: _ -> begin + match !template_insertion_modes with + | [] -> initial_mode (* This is an internal error, actually. *) + | mode :: _ -> mode end (* The next case corresponds to item 12 of "Resetting the insertion mode appropriately." It is commented out as deliberate deviation from the @@ -1160,1780 +1228,1576 @@ let parse ?depth_limit requested_context report tokens = elements more intuitive. For conformance, the pattern in the following case would have to end with ::_::_, not ::_. *) (* | [{element_name = _, "head"}] -> in_body_mode *) - | {element_name = _, "head"}::_ -> in_head_mode - | {element_name = _, "body"}::_ -> in_body_mode - | {element_name = _, "frameset"}::_ -> in_frameset_mode - | {element_name = _, "html"}::_ -> - if !head_seen then after_head_mode else before_head_mode - | _::rest -> iterate last rest + | { element_name = _, "head" } :: _ -> in_head_mode + | { element_name = _, "body" } :: _ -> in_body_mode + | { element_name = _, "frameset" } :: _ -> in_frameset_mode + | { element_name = _, "html" } :: _ -> + if !head_seen then after_head_mode else before_head_mode + | _ :: rest -> iterate last rest | [] -> in_body_mode in iterate false !(Stack.elements open_elements) - and emit' l s m = if Subtree.accumulate subtree_buffer l s then begin current_mode := m; !output (l, s) end else m () - and emit_list ss m = match ss with | [] -> m () - | (l, s)::more -> emit' l s (fun () -> emit_list more m) - + | (l, s) :: more -> emit' l s (fun () -> emit_list more m) and emit_text m = match Text.emit text with | None -> m () - | Some (l', strings) -> - emit' l' (`Text strings) m - + | Some (l', strings) -> emit' l' (`Text strings) m and emit l s m = emit_text (fun () -> emit' l s m) + and push_and_emit ?(formatting = false) ?(acknowledge = false) + ?(namespace = `HTML) ?(set_form_element_pointer = false) location + ({ Token_tag.name; attributes; self_closing } as tag) mode = + report_if + (self_closing && not acknowledge) + location + (fun () -> `Bad_token ("/>", "tag", "should not be self-closing")) + !throw + (fun () -> + let namespace_string = Ns.to_string namespace in - and push_and_emit - ?(formatting = false) ?(acknowledge = false) ?(namespace = `HTML) - ?(set_form_element_pointer = false) location - ({Token_tag.name; attributes; self_closing} as tag) mode = - - report_if (self_closing && not acknowledge) location (fun () -> - `Bad_token ("/>", "tag", "should not be self-closing")) - !throw (fun () -> - - let namespace_string = Ns.to_string namespace in - - let tag_name = - match namespace with - | `SVG -> Foreign.adjust_svg_tag_name name - | _ -> name - in - - let is_html_integration_point = - Foreign.is_html_integration_point namespace tag_name attributes in + let tag_name = + match namespace with + | `SVG -> Foreign.adjust_svg_tag_name name + | _ -> name + in - let attributes = - List.map (fun (n, v) -> Namespace.Parsing.parse n, v) attributes in - let attributes = - match namespace with - | `HTML | `Other _ -> attributes - | `MathML -> Foreign.adjust_mathml_attributes attributes - | `SVG -> Foreign.adjust_svg_attributes attributes - in + let is_html_integration_point = + Foreign.is_html_integration_point namespace tag_name attributes + in - let element_entry = - Element.create ~is_html_integration_point (namespace, name) location - in - let elements_ref = Stack.elements open_elements in - elements_ref := element_entry::!elements_ref; + let attributes = + List.map (fun (n, v) -> (Namespace.Parsing.parse n, v)) attributes + in + let attributes = + match namespace with + | `HTML | `Other _ -> attributes + | `MathML -> Foreign.adjust_mathml_attributes attributes + | `SVG -> Foreign.adjust_svg_attributes attributes + in - if set_form_element_pointer then - form_element_pointer := Some element_entry; + let element_entry = + Element.create ~is_html_integration_point (namespace, name) location + in + let elements_ref = Stack.elements open_elements in + elements_ref := element_entry :: !elements_ref; - if formatting then - active_formatting_elements := - Active.Element_ (element_entry, location, tag):: - !active_formatting_elements; + if set_form_element_pointer then + form_element_pointer := Some element_entry; - emit location - (`Start_element ((namespace_string, tag_name), attributes)) mode) + if formatting then + active_formatting_elements := + Active.Element_ (element_entry, location, tag) + :: !active_formatting_elements; + emit location + (`Start_element ((namespace_string, tag_name), attributes)) + mode) and push_implicit location name mode = push_and_emit location - {Token_tag.name = name; attributes = []; self_closing = false} mode - + { Token_tag.name; attributes = []; self_closing = false } + mode and pop location mode = match !(Stack.elements open_elements) with | [] -> mode () - | element::more -> - emit_text (fun () -> - (fun k -> - if not element.buffering then k () - else emit_list (Subtree.disable subtree_buffer) k) - (fun () -> - (Stack.elements open_elements) := more; - element.is_open <- false; - if element.suppress then mode () - else emit' location `End_element mode)) - + | element :: more -> + emit_text (fun () -> + (fun k -> + if not element.buffering then k () + else emit_list (Subtree.disable subtree_buffer) k) (fun () -> + Stack.elements open_elements := more; + element.is_open <- false; + if element.suppress then mode () + else emit' location `End_element mode)) and pop_until condition location mode = let rec iterate () = match !(Stack.elements open_elements) with | [] -> mode () - | element::_ -> - if condition element then mode () - else pop location iterate + | element :: _ -> + if condition element then mode () else pop location iterate in iterate () - and close_element ?(ns = `HTML) l name mode = pop_until - (fun {element_name = ns', name'} -> ns' = ns && name' = name) l - (fun () -> - pop l mode) - + (fun { element_name = ns', name' } -> ns' = ns && name' = name) + l + (fun () -> pop l mode) and pop_until_and_raise_errors names location mode = let rec iterate () = match !(Stack.elements open_elements) with | [] -> mode () - | {element_name = ns, name}::_ -> - if ns = `HTML && list_mem_string name names then pop location mode - else - report location (`Unmatched_start_tag name) !throw (fun () -> - pop location iterate) + | { element_name = ns, name } :: _ -> + if ns = `HTML && list_mem_string name names then pop location mode + else + report location (`Unmatched_start_tag name) !throw (fun () -> + pop location iterate) in iterate () - and pop_implied ?(except = "") location mode = - pop_until (fun {element_name = _, name} -> - name = except || - not @@ list_mem_string name - ["dd"; "dt"; "li"; "option"; "optgroup"; "p"; "rb"; "rp"; "rt"; - "rtc"]) location mode - + pop_until + (fun { element_name = _, name } -> + name = except + || not + @@ list_mem_string name + [ + "dd"; + "dt"; + "li"; + "option"; + "optgroup"; + "p"; + "rb"; + "rp"; + "rt"; + "rtc"; + ]) + location mode and pop_to_table_context location mode = - pop_until (function - | {element_name = `HTML, ("table" | "template" | "html")} -> true - | _ -> false) location mode - + pop_until + (function + | { element_name = `HTML, ("table" | "template" | "html") } -> true + | _ -> false) + location mode and pop_to_table_body_context location mode = - pop_until (function - | {element_name = - `HTML, ("tbody" | "thead" | "tfoot" | "template" | "html")} -> true - | _ -> false) location mode - + pop_until + (function + | { + element_name = + `HTML, ("tbody" | "thead" | "tfoot" | "template" | "html"); + } -> + true + | _ -> false) + location mode and pop_to_table_row_context location mode = - pop_until (function - | {element_name = `HTML, ("tr" | "template" | "html")} -> true - | _ -> false) location mode - + pop_until + (function + | { element_name = `HTML, ("tr" | "template" | "html") } -> true + | _ -> false) + location mode and close_element_with_implied name location mode = pop_implied ~except:name location (fun () -> - let check_element k = - match Stack.current_element open_elements with - | Some {element_name = `HTML, name'} when name' = name -> k () - | Some {element_name = _, name; location} -> - report location (`Unmatched_start_tag name) !throw k - | None -> - unmatched_end_tag location name k - in - check_element (fun () -> - close_element location name mode)) - + let check_element k = + match Stack.current_element open_elements with + | Some { element_name = `HTML, name' } when name' = name -> k () + | Some { element_name = _, name; location } -> + report location (`Unmatched_start_tag name) !throw k + | None -> unmatched_end_tag location name k + in + check_element (fun () -> close_element location name mode)) and close_cell location mode = pop_implied location (fun () -> - (fun mode -> - match Stack.current_element open_elements with - | Some {element_name = `HTML, ("td" | "th")} -> mode () - | Some {element_name = _, name} -> - unmatched_end_tag location name mode - | None -> - unmatched_end_tag location "" mode) - @@ (fun () -> - pop_until (function - | {element_name = `HTML, ("td" | "th")} -> true - | _ -> false) location (fun () -> - pop location mode))) - + (fun mode -> + match Stack.current_element open_elements with + | Some { element_name = `HTML, ("td" | "th") } -> mode () + | Some { element_name = _, name } -> + unmatched_end_tag location name mode + | None -> unmatched_end_tag location "" mode) + @@ fun () -> + pop_until + (function + | { element_name = `HTML, ("td" | "th") } -> true | _ -> false) + location + (fun () -> pop location mode)) and close_current_p_element l mode = if Stack.in_button_scope open_elements "p" then close_element_with_implied "p" l mode else mode () - and close_preceding_tag names l mode = let rec scan = function | [] -> mode () - | {element_name = (ns, name) as name'}::more -> - if ns = `HTML && list_mem_string name names then - close_element_with_implied name l mode - else - if Element.is_special name' && - not @@ list_mem_qname name' - [`HTML, "address"; `HTML, "div"; `HTML, "p"] then - mode () - else - scan more + | { element_name = (ns, name) as name' } :: more -> + if ns = `HTML && list_mem_string name names then + close_element_with_implied name l mode + else if + Element.is_special name' + && not + @@ list_mem_qname name' + [ (`HTML, "address"); (`HTML, "div"); (`HTML, "p") ] + then mode () + else scan more in scan !(Stack.elements open_elements) - and emit_end l = - pop_until (fun _ -> false) l (fun () -> - emit_text (fun () -> - !ended ())) - + pop_until (fun _ -> false) l (fun () -> emit_text (fun () -> !ended ())) and reconstruct_active_formatting_elements mode = let rec get_prefix prefix = function - | [] -> prefix, [] - | Active.Marker::_ as l -> prefix, l - | Active.Element_ ({is_open = true}, _, _)::_ as l -> prefix, l - | Active.Element_ ({is_open = false}, l, tag)::more -> - get_prefix ((l, tag)::prefix) more + | [] -> (prefix, []) + | Active.Marker :: _ as l -> (prefix, l) + | Active.Element_ ({ is_open = true }, _, _) :: _ as l -> (prefix, l) + | Active.Element_ ({ is_open = false }, l, tag) :: more -> + get_prefix ((l, tag) :: prefix) more in let to_reopen, remainder = get_prefix [] !active_formatting_elements in active_formatting_elements := remainder; begin match to_reopen with | [] -> () - | _::_ -> Subtree.enable subtree_buffer + | _ :: _ -> Subtree.enable subtree_buffer end; let rec reopen = function | [] -> mode () - | (l, tag)::more -> - push_and_emit ~formatting:true l tag (fun () -> reopen more) + | (l, tag) :: more -> + push_and_emit ~formatting:true l tag (fun () -> reopen more) in reopen to_reopen - (* 8.2.5. *) and dispatch tokens rules = next tokens !throw (fun () -> !ended ()) begin fun ((_, t) as v) -> let foreign = - match Stack.adjusted_current_element context open_elements, t with + match (Stack.adjusted_current_element context open_elements, t) with | None, _ -> false - | Some {element_name = `HTML, _}, _ -> false - | Some {element_name}, `Start {name} - when Foreign.is_mathml_text_integration_point element_name - && name <> "mglyph" && name <> "malignmark" -> false - | Some {element_name = `MathML, "annotation-xml"}, - `Start {name = "svg"} -> false - | Some {is_html_integration_point = true}, `Start _ -> false - | Some {is_html_integration_point = true}, `Char _ -> false - | Some {is_html_integration_point = true}, `String _ -> false + | Some { element_name = `HTML, _ }, _ -> false + | Some { element_name }, `Start { name } + when Foreign.is_mathml_text_integration_point element_name + && name <> "mglyph" && name <> "malignmark" -> + false + | ( Some { element_name = `MathML, "annotation-xml" }, + `Start { name = "svg" } ) -> + false + | Some { is_html_integration_point = true }, `Start _ -> false + | Some { is_html_integration_point = true }, `Char _ -> false + | Some { is_html_integration_point = true }, `String _ -> false | _, `EOF -> false | _ -> true in if not foreign then rules v else foreign_content !current_mode (fun () -> rules v) v - end - + end (* 8.2.5.4.1. *) and initial_mode () = dispatch tokens begin function - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> - initial_mode () - - | _, `String s when is_whitespace_only s -> - initial_mode () - - | l, `Comment s -> - emit l (`Comment s) initial_mode - - | l, `Doctype d -> - emit l (`Doctype d) before_html_mode - - | v -> - push tokens v; - before_html_mode () - end - + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> + initial_mode () + | _, `String s when is_whitespace_only s -> initial_mode () + | l, `Comment s -> emit l (`Comment s) initial_mode + | l, `Doctype d -> emit l (`Doctype d) before_html_mode + | v -> + push tokens v; + before_html_mode () + end (* 8.2.5.4.2. *) and before_html_mode () = dispatch tokens begin function - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - before_html_mode - - | l, `Comment s -> - emit l (`Comment s) before_html_mode - - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> - before_html_mode () - - | _, `String s when is_whitespace_only s -> - before_html_mode () - - | l, `Start ({name = "html"} as t) -> - push_and_emit l t before_head_mode - - | l, `End {name} - when not @@ list_mem_string name ["head"; "body"; "html"; "br"] -> - unmatched_end_tag l name before_html_mode - - | l, _ as v -> - push tokens v; - push_implicit l "html" before_head_mode - end - + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + before_html_mode + | l, `Comment s -> emit l (`Comment s) before_html_mode + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> + before_html_mode () + | _, `String s when is_whitespace_only s -> before_html_mode () + | l, `Start ({ name = "html" } as t) -> + push_and_emit l t before_head_mode + | l, `End { name } + when not @@ list_mem_string name [ "head"; "body"; "html"; "br" ] -> + unmatched_end_tag l name before_html_mode + | (l, _) as v -> + push tokens v; + push_implicit l "html" before_head_mode + end (* 8.2.5.4.3. *) and before_head_mode () = dispatch tokens begin function - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> - before_head_mode () - - | _, `String s when is_whitespace_only s -> - before_head_mode () - - | l, `Comment s -> - emit l (`Comment s) before_head_mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - before_head_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "html" before_head_mode v - - | l, `Start ({name = "head"} as t) -> - head_seen := true; - push_and_emit l t in_head_mode - - | l, `End {name} - when not @@ list_mem_string name ["head"; "body"; "html"; "br"] -> - report l (`Unmatched_end_tag name) !throw before_head_mode - - | l, _ as v -> - head_seen := true; - push tokens v; - push_implicit l "head" in_head_mode - end - + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) -> + before_head_mode () + | _, `String s when is_whitespace_only s -> before_head_mode () + | l, `Comment s -> emit l (`Comment s) before_head_mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + before_head_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "html" before_head_mode v + | l, `Start ({ name = "head" } as t) -> + head_seen := true; + push_and_emit l t in_head_mode + | l, `End { name } + when not @@ list_mem_string name [ "head"; "body"; "html"; "br" ] -> + report l (`Unmatched_end_tag name) !throw before_head_mode + | (l, _) as v -> + head_seen := true; + push tokens v; + push_implicit l "head" in_head_mode + end (* 8.2.5.4.4. *) and in_head_mode () = dispatch tokens (fun v -> in_head_mode_rules in_head_mode v) - (* 8.2.5.4.4. *) and in_head_mode_rules mode = function - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - add_character l c; - mode () - + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + add_character l c; + mode () | l, `String s when is_whitespace_only s -> - add_string l s; - mode () - - | l, `Comment s -> - emit l (`Comment s) mode - + add_string l s; + mode () + | l, `Comment s -> emit l (`Comment s) mode | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "head" in_head_mode v - - | l, `Start ({name = - "base" | "basefont" | "bgsound" | "link" | "meta"} as t) -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l mode) - - | l, `Start ({name = "title"} as t) -> - push_and_emit l t (fun () -> - parse_rcdata mode) - - | l, `Start ({name = "noframes" | "style"} as t) -> - push_and_emit l t (fun () -> - parse_rawtext mode) - - | l, `Start ({name = "noscript"} as t) -> - push_and_emit l t in_head_noscript_mode - - | l, `Start ({name = "script"} as t) -> - push_and_emit l t (fun () -> - set_tokenizer_state `Script_data; - text_mode mode) - - | l, `End {name = "head"} -> - pop l after_head_mode - - | l, `Start ({name = "template"} as t) -> - Active.add_marker active_formatting_elements; - frameset_ok := false; - Template.push template_insertion_modes in_template_mode; - push_and_emit l t in_template_mode - - | l, `End {name = "template"} -> - if not @@ Stack.has open_elements "template" then - report l (`Unmatched_end_tag "template") !throw mode - else begin - Active.clear_until_marker active_formatting_elements; - Template.pop template_insertion_modes; - close_element_with_implied "template" l (fun () -> reset_mode () ()) - end - - | l, `Start ({name = "head"} as t) -> - misnested_tag l t "head" mode - - | l, `End {name} when not @@ list_mem_string name ["body"; "html"; "br"] -> - report l (`Unmatched_end_tag name) !throw mode - - | l, _ as v -> - push tokens v; - pop l after_head_mode - + report l (`Bad_document "doctype should be first") !throw mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "head" in_head_mode v + | ( l, + `Start + ({ name = "base" | "basefont" | "bgsound" | "link" | "meta" } as t) ) + -> + push_and_emit ~acknowledge:true l t (fun () -> pop l mode) + | l, `Start ({ name = "title" } as t) -> + push_and_emit l t (fun () -> parse_rcdata mode) + | l, `Start ({ name = "noframes" | "style" } as t) -> + push_and_emit l t (fun () -> parse_rawtext mode) + | l, `Start ({ name = "noscript" } as t) -> + push_and_emit l t in_head_noscript_mode + | l, `Start ({ name = "script" } as t) -> + push_and_emit l t (fun () -> + set_tokenizer_state `Script_data; + text_mode mode) + | l, `End { name = "head" } -> pop l after_head_mode + | l, `Start ({ name = "template" } as t) -> + Active.add_marker active_formatting_elements; + frameset_ok := false; + Template.push template_insertion_modes in_template_mode; + push_and_emit l t in_template_mode + | l, `End { name = "template" } -> + if not @@ Stack.has open_elements "template" then + report l (`Unmatched_end_tag "template") !throw mode + else begin + Active.clear_until_marker active_formatting_elements; + Template.pop template_insertion_modes; + close_element_with_implied "template" l (fun () -> reset_mode () ()) + end + | l, `Start ({ name = "head" } as t) -> misnested_tag l t "head" mode + | l, `End { name } when not @@ list_mem_string name [ "body"; "html"; "br" ] + -> + report l (`Unmatched_end_tag name) !throw mode + | (l, _) as v -> + push tokens v; + pop l after_head_mode (* 8.2.5.4.5. *) and in_head_noscript_mode () = dispatch tokens begin function - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - in_head_noscript_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "noscript" in_head_noscript_mode v - - | l, `End {name = "noscript"} -> - pop l in_head_mode - - | _, `String s as v when is_whitespace_only s -> - in_head_mode_rules in_head_noscript_mode v - - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) - | _, `Comment _ - | _, `Start {name = - "basefont" | "bgsound" | "link" | "meta" | "noframes" | - "style"} as v -> - in_head_mode_rules in_head_noscript_mode v - - | l, `Start ({name = "head" | "noscript"} as t) -> - misnested_tag l t "noscript" in_head_noscript_mode - - | l, `End {name} when name <> "br" -> - report l (`Unmatched_end_tag name) !throw in_head_noscript_mode - - | l, _ as v -> - report l (`Bad_content "noscript") !throw (fun () -> - push tokens v; - pop l in_head_mode) - end - + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + in_head_noscript_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "noscript" in_head_noscript_mode v + | l, `End { name = "noscript" } -> pop l in_head_mode + | (_, `String s) as v when is_whitespace_only s -> + in_head_mode_rules in_head_noscript_mode v + | ( _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) + | _, `Comment _ + | ( _, + `Start + { + name = + ( "basefont" | "bgsound" | "link" | "meta" | "noframes" + | "style" ); + } ) ) as v -> + in_head_mode_rules in_head_noscript_mode v + | l, `Start ({ name = "head" | "noscript" } as t) -> + misnested_tag l t "noscript" in_head_noscript_mode + | l, `End { name } when name <> "br" -> + report l (`Unmatched_end_tag name) !throw in_head_noscript_mode + | (l, _) as v -> + report l (`Bad_content "noscript") !throw (fun () -> + push tokens v; + pop l in_head_mode) + end (* 8.2.5.4.6. *) and after_head_mode () = dispatch tokens begin function - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - add_character l c; - after_head_mode () - - | l, `String s when is_whitespace_only s -> - add_string l s; - after_head_mode () - - | l, `Comment s -> - emit l (`Comment s) after_head_mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - after_head_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "html" after_head_mode v - - | l, `Start ({name = "body"} as t) -> - frameset_ok := false; - push_and_emit l t in_body_mode - - | l, `Start ({name = "frameset"} as t) -> - push_and_emit l t in_frameset_mode - - | l, `Start ({name = - "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | - "script" | "style" | "template" | "title"} as t) as v -> - misnested_tag l t "html" (fun () -> - in_head_mode_rules after_head_mode v) - - | _, `End {name = "template"} as v -> - in_head_mode_rules after_head_mode v - - | l, `Start {name = "head"} -> - report l (`Bad_document "duplicate head element") !throw - after_head_mode - - | l, `End {name} - when not @@ list_mem_string name ["body"; "html"; "br"] -> - report l (`Unmatched_end_tag name) !throw after_head_mode - - (* This case is not found in the specification. It is a deliberate + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + add_character l c; + after_head_mode () + | l, `String s when is_whitespace_only s -> + add_string l s; + after_head_mode () + | l, `Comment s -> emit l (`Comment s) after_head_mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + after_head_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "html" after_head_mode v + | l, `Start ({ name = "body" } as t) -> + frameset_ok := false; + push_and_emit l t in_body_mode + | l, `Start ({ name = "frameset" } as t) -> + push_and_emit l t in_frameset_mode + | ( l, + `Start + ({ + name = + ( "base" | "basefont" | "bgsound" | "link" | "meta" + | "noframes" | "script" | "style" | "template" | "title" ); + } as t) ) as v -> + misnested_tag l t "html" (fun () -> + in_head_mode_rules after_head_mode v) + | (_, `End { name = "template" }) as v -> + in_head_mode_rules after_head_mode v + | l, `Start { name = "head" } -> + report l (`Bad_document "duplicate head element") !throw + after_head_mode + | l, `End { name } + when not @@ list_mem_string name [ "body"; "html"; "br" ] -> + report l (`Unmatched_end_tag name) !throw after_head_mode + (* This case is not found in the specification. It is a deliberate deviation from conformance, so that fragments "..." don't get an implicit element generated after the element. *) - | l, `EOF - when (Context.the_context context = `Fragment (`HTML, "html") - || Context.the_context context = `Fragment (`HTML, "head")) -> - emit_end l - - | l, _ as t -> - push tokens t; - push_implicit l "body" in_body_mode - end - + | l, `EOF + when Context.the_context context = `Fragment (`HTML, "html") + || Context.the_context context = `Fragment (`HTML, "head") -> + emit_end l + | (l, _) as t -> + push tokens t; + push_implicit l "body" in_body_mode + end (* 8.2.5.4.7. *) and in_body_mode () = dispatch tokens (fun v -> in_body_mode_rules "body" in_body_mode v) - (* 8.2.5.4.7. *) and in_body_mode_rules context_name mode = function - | l, `Char 0 -> - report l (`Bad_token ("U+0000", "body", "null")) !throw mode - - | l, `String s -> - reconstruct_active_formatting_elements (fun () -> - add_string l s; - if not @@ is_whitespace_only s then frameset_ok := false; - mode ()) - - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - reconstruct_active_formatting_elements (fun () -> - add_character l c; - mode ()) - + | l, `Char 0 -> report l (`Bad_token ("U+0000", "body", "null")) !throw mode + | l, `String s -> + reconstruct_active_formatting_elements (fun () -> + add_string l s; + if not @@ is_whitespace_only s then frameset_ok := false; + mode ()) + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + reconstruct_active_formatting_elements (fun () -> + add_character l c; + mode ()) | l, `Char c -> - frameset_ok := false; - reconstruct_active_formatting_elements (fun () -> - add_character l c; - mode ()) - - | l, `Comment s -> - emit l (`Comment s) mode - + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + add_character l c; + mode ()) + | l, `Comment s -> emit l (`Comment s) mode | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw mode - - | l, `Start ({name = "html"} as t) -> - misnested_tag l t context_name mode - - | _, `Start {name = - "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | - "script" | "style" | "template" | "title"} - | _, `End {name = "template"} as v -> - in_head_mode_rules mode v - - | l, `Start ({name = "body"} as t) -> - misnested_tag l t context_name mode - - | l, `Start ({name = "frameset"} as t) -> - misnested_tag l t context_name (fun () -> - match !(Stack.elements open_elements) with - | [_] -> mode () - | _ -> - let rec second_is_body = function - | [{element_name = `HTML, "body"}; _] -> true - | [] -> false - | _::more -> second_is_body more - in - if not @@ second_is_body !(Stack.elements open_elements) then mode () - else - if not !frameset_ok then mode () - else - (* There is a deviation here due to the nature of the parser: if a + report l (`Bad_document "doctype should be first") !throw mode + | l, `Start ({ name = "html" } as t) -> misnested_tag l t context_name mode + | ( ( _, + `Start + { + name = + ( "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" + | "script" | "style" | "template" | "title" ); + } ) + | _, `End { name = "template" } ) as v -> + in_head_mode_rules mode v + | l, `Start ({ name = "body" } as t) -> misnested_tag l t context_name mode + | l, `Start ({ name = "frameset" } as t) -> + misnested_tag l t context_name (fun () -> + match !(Stack.elements open_elements) with + | [ _ ] -> mode () + | _ -> + let rec second_is_body = function + | [ { element_name = `HTML, "body" }; _ ] -> true + | [] -> false + | _ :: more -> second_is_body more + in + if not @@ second_is_body !(Stack.elements open_elements) then + mode () + else if not !frameset_ok then mode () + else + (* There is a deviation here due to the nature of the parser: if a body element has been emitted, it can't be suppressed. *) - pop_until - (fun _ -> match !(Stack.elements open_elements) with [_] -> true | _ -> false) - l (fun () -> - push_and_emit l t in_frameset_mode)) - - | l, `EOF as v -> - report_if_stack_has_other_than - ["dd"; "dt"; "li"; "p"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr"; - "body"; "html"] (fun () -> - match !template_insertion_modes with - | [] -> emit_end l - | _ -> in_template_mode_rules mode v) - - | l, `End {name = "body"} -> - if not @@ Stack.in_scope open_elements "body" then - report l (`Unmatched_end_tag "body") !throw mode - else + pop_until + (fun _ -> + match !(Stack.elements open_elements) with + | [ _ ] -> true + | _ -> false) + l + (fun () -> push_and_emit l t in_frameset_mode)) + | (l, `EOF) as v -> report_if_stack_has_other_than - ["dd"; "dt"; "li"; "optgroup"; "option"; "p"; "rb"; "rp"; "rt"; - "rtc"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr"; "body"; - "html"] (fun () -> - after_body_mode ()) - - | l, `End {name = "html"} as v -> - if not @@ Stack.in_scope open_elements "body" then - report l (`Unmatched_end_tag "html") !throw mode - else - report_if_stack_has_other_than - ["dd"; "dt"; "li"; "optgroup"; "option"; "p"; "rb"; "rp"; "rt"; - "rtc"; "tbody"; "td"; "tfoot"; "th"; "thead"; "tr"; "body"; - "html"] (fun () -> - push tokens v; - after_body_mode ()) - - | l, `Start ({name = - "address" | "article" | "aside" | "blockquote" | "center" | - "details" | "dialog" | "dir" | "div" | "dl" | "fieldset" | - "figcaption" | "figure" | "footer" | "header" | "hgroup" | "main" | - "nav" | "ol" | "p" | "section" | "summary" | "ul"} as t) -> - close_current_p_element l (fun () -> - push_and_emit l t mode) - - | l, `Start ({name = - "h1" | "h2" | "h3" | "h4" | "h5" | "h6"} as t) -> - close_current_p_element l (fun () -> - (fun mode' -> - match Stack.current_element open_elements with - | Some {element_name = `HTML, - ("h1" | "h2" | "h3" | "h4" | "h5" | "h6" as name')} -> - misnested_tag l t name' (fun () -> - pop l mode') - | _ -> mode' ()) (fun () -> - push_and_emit l t mode)) - - | l, `Start ({name = "pre" | "listing"} as t) -> - frameset_ok := false; - close_current_p_element l (fun () -> - push_and_emit l t (fun () -> - (* https://html.spec.whatwg.org/multipage/grouping-content.html#the-pre-element *) - (* In the HTML syntax, a leading newline character immediately following the pre element start tag is stripped. *) - next_expected tokens !throw (function - | _, `Char 0x000A -> mode () - | loc, `String s when String.starts_with ~prefix:"\n" s -> push tokens (loc, `String (String.sub s 1 (String.length s - 1))); mode () - | v -> - push tokens v; - mode ()))) - - | l, `Start ({name = "form"} as t) -> - if !form_element_pointer <> None && - not @@ Stack.has open_elements "template" then - misnested_tag l t "form" mode - else begin + [ + "dd"; + "dt"; + "li"; + "p"; + "tbody"; + "td"; + "tfoot"; + "th"; + "thead"; + "tr"; + "body"; + "html"; + ] (fun () -> + match !template_insertion_modes with + | [] -> emit_end l + | _ -> in_template_mode_rules mode v) + | l, `End { name = "body" } -> + if not @@ Stack.in_scope open_elements "body" then + report l (`Unmatched_end_tag "body") !throw mode + else + report_if_stack_has_other_than + [ + "dd"; + "dt"; + "li"; + "optgroup"; + "option"; + "p"; + "rb"; + "rp"; + "rt"; + "rtc"; + "tbody"; + "td"; + "tfoot"; + "th"; + "thead"; + "tr"; + "body"; + "html"; + ] (fun () -> after_body_mode ()) + | (l, `End { name = "html" }) as v -> + if not @@ Stack.in_scope open_elements "body" then + report l (`Unmatched_end_tag "html") !throw mode + else + report_if_stack_has_other_than + [ + "dd"; + "dt"; + "li"; + "optgroup"; + "option"; + "p"; + "rb"; + "rp"; + "rt"; + "rtc"; + "tbody"; + "td"; + "tfoot"; + "th"; + "thead"; + "tr"; + "body"; + "html"; + ] (fun () -> + push tokens v; + after_body_mode ()) + | ( l, + `Start + ({ + name = + ( "address" | "article" | "aside" | "blockquote" | "center" + | "details" | "dialog" | "dir" | "div" | "dl" | "fieldset" + | "figcaption" | "figure" | "footer" | "header" | "hgroup" + | "main" | "nav" | "ol" | "p" | "section" | "summary" | "ul" ); + } as t) ) -> + close_current_p_element l (fun () -> push_and_emit l t mode) + | l, `Start ({ name = "h1" | "h2" | "h3" | "h4" | "h5" | "h6" } as t) -> close_current_p_element l (fun () -> - let in_template = Stack.has open_elements "template" in - push_and_emit ~set_form_element_pointer:(not in_template) l t mode) - end - - | l, `Start ({name = "li"} as t) -> - frameset_ok := false; - close_preceding_tag ["li"] l (fun () -> - close_current_p_element l (fun () -> - push_and_emit l t mode)) - - | l, `Start ({name = "dd" | "dt"} as t) -> - frameset_ok := false; - close_preceding_tag ["dd"; "dt"] l (fun () -> - close_current_p_element l (fun () -> - push_and_emit l t mode)) - - | l, `Start ({name = "plaintext"} as t) -> - close_current_p_element l (fun () -> - set_tokenizer_state `PLAINTEXT; - push_and_emit l t mode) - - | l, `Start ({name = "button"} as t) -> - (fun mode' -> - if Stack.in_scope open_elements "button" then - misnested_tag l t "button" (fun () -> - close_element_with_implied "button" l mode') - else mode' ()) - (fun () -> + (fun mode' -> + match Stack.current_element open_elements with + | Some + { + element_name = + ( `HTML, + (("h1" | "h2" | "h3" | "h4" | "h5" | "h6") as name') ); + } -> + misnested_tag l t name' (fun () -> pop l mode') + | _ -> mode' ()) (fun () -> push_and_emit l t mode)) + | l, `Start ({ name = "pre" | "listing" } as t) -> frameset_ok := false; - reconstruct_active_formatting_elements (fun () -> - push_and_emit l t mode)) - - | l, `End {name = - "address" | "article" | "aside" | "blockquote" | "button" | - "center" | "details" | "dialog" | "dir" | "div" | "dl" | "fieldset" | - "figcaption" | "figure" | "footer" | "header" | "hgroup" | "listing" | - "main" | "nav" | "ol" | "pre" | "section" | "summary" | "ul" - as name} -> - if not @@ Stack.in_scope open_elements name then - report l (`Unmatched_end_tag name) !throw mode - else - close_element_with_implied name l mode - - | l, `End {name = "form"} -> - if not @@ Stack.has open_elements "template" then begin - let form_element = !form_element_pointer in - form_element_pointer := None; - match form_element with - | Some element when Stack.target_in_scope open_elements element -> - pop_implied l (fun () -> - match Stack.current_element open_elements with - | Some element' when element' == element -> - pop l mode - | _ -> - report element.location (`Unmatched_start_tag "form") !throw - (fun () -> - pop_until (fun element' -> element' == element) l (fun () -> - pop l mode))) - | _ -> - report l (`Unmatched_end_tag "form") !throw mode - end - else - if not @@ Stack.in_scope open_elements "form" then + close_current_p_element l (fun () -> + push_and_emit l t (fun () -> + (* https://html.spec.whatwg.org/multipage/grouping-content.html#the-pre-element *) + (* In the HTML syntax, a leading newline character immediately following the pre element start tag is stripped. *) + next_expected tokens !throw (function + | _, `Char 0x000A -> mode () + | loc, `String s when String.starts_with ~prefix:"\n" s -> + push tokens + (loc, `String (String.sub s 1 (String.length s - 1))); + mode () + | v -> + push tokens v; + mode ()))) + | l, `Start ({ name = "form" } as t) -> + if + !form_element_pointer <> None + && (not @@ Stack.has open_elements "template") + then misnested_tag l t "form" mode + else begin + close_current_p_element l (fun () -> + let in_template = Stack.has open_elements "template" in + push_and_emit ~set_form_element_pointer:(not in_template) l t mode) + end + | l, `Start ({ name = "li" } as t) -> + frameset_ok := false; + close_preceding_tag [ "li" ] l (fun () -> + close_current_p_element l (fun () -> push_and_emit l t mode)) + | l, `Start ({ name = "dd" | "dt" } as t) -> + frameset_ok := false; + close_preceding_tag [ "dd"; "dt" ] l (fun () -> + close_current_p_element l (fun () -> push_and_emit l t mode)) + | l, `Start ({ name = "plaintext" } as t) -> + close_current_p_element l (fun () -> + set_tokenizer_state `PLAINTEXT; + push_and_emit l t mode) + | l, `Start ({ name = "button" } as t) -> + (fun mode' -> + if Stack.in_scope open_elements "button" then + misnested_tag l t "button" (fun () -> + close_element_with_implied "button" l mode') + else mode' ()) (fun () -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t mode)) + | ( l, + `End + { + name = + ( "address" | "article" | "aside" | "blockquote" | "button" + | "center" | "details" | "dialog" | "dir" | "div" | "dl" + | "fieldset" | "figcaption" | "figure" | "footer" | "header" + | "hgroup" | "listing" | "main" | "nav" | "ol" | "pre" | "section" + | "summary" | "ul" ) as name; + } ) -> + if not @@ Stack.in_scope open_elements name then + report l (`Unmatched_end_tag name) !throw mode + else close_element_with_implied name l mode + | l, `End { name = "form" } -> + if not @@ Stack.has open_elements "template" then begin + let form_element = !form_element_pointer in + form_element_pointer := None; + match form_element with + | Some element when Stack.target_in_scope open_elements element -> + pop_implied l (fun () -> + match Stack.current_element open_elements with + | Some element' when element' == element -> pop l mode + | _ -> + report element.location (`Unmatched_start_tag "form") + !throw (fun () -> + pop_until + (fun element' -> element' == element) + l + (fun () -> pop l mode))) + | _ -> report l (`Unmatched_end_tag "form") !throw mode + end + else if not @@ Stack.in_scope open_elements "form" then report l (`Unmatched_end_tag "form") !throw mode + else close_element_with_implied "form" l mode + | l, `End { name = "p" } -> + (fun mode' -> + if not @@ Stack.in_button_scope open_elements "p" then + report l (`Unmatched_end_tag "p") !throw (fun () -> + push_implicit l "p" mode') + else mode' ()) (fun () -> close_element_with_implied "p" l mode) + | l, `End { name = "li" } -> + if not @@ Stack.in_list_item_scope open_elements "li" then + report l (`Unmatched_end_tag "li") !throw mode + else close_element_with_implied "li" l mode + | l, `End { name = ("dd" | "dt") as name } -> + if not @@ Stack.in_scope open_elements name then + report l (`Unmatched_end_tag name) !throw mode + else close_element_with_implied name l mode + | l, `End { name = ("h1" | "h2" | "h3" | "h4" | "h5" | "h6") as name } -> + if + not + @@ Stack.one_in_scope open_elements + [ "h1"; "h2"; "h3"; "h4"; "h5"; "h6" ] + then report l (`Unmatched_end_tag name) !throw mode else - close_element_with_implied "form" l mode - - | l, `End {name = "p"} -> - (fun mode' -> - if not @@ Stack.in_button_scope open_elements "p" then - report l (`Unmatched_end_tag "p") !throw (fun () -> - push_implicit l "p" mode') - else mode' ()) - (fun () -> close_element_with_implied "p" l mode) - - | l, `End {name = "li"} -> - if not @@ Stack.in_list_item_scope open_elements "li" then - report l (`Unmatched_end_tag "li") !throw mode - else - close_element_with_implied "li" l mode - - | l, `End {name = "dd" | "dt" as name} -> - if not @@ Stack.in_scope open_elements name then - report l (`Unmatched_end_tag name) !throw mode - else - close_element_with_implied name l mode - - | l, `End {name = "h1" | "h2" | "h3" | "h4" | "h5" | "h6" as name} -> - if not @@ Stack.one_in_scope open_elements - ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] then - report l (`Unmatched_end_tag name) !throw mode - else - pop_implied l (fun () -> - (fun next -> - match Stack.current_element open_elements with - | Some {element_name = `HTML, name'} - when list_mem_string - name' ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] -> - next () - | _ -> - report l (`Unmatched_end_tag name) !throw next) - @@ (fun () -> - pop_until_and_raise_errors - ["h1"; "h2"; "h3"; "h4"; "h5"; "h6"] l mode)) - - | l, `Start ({name = "a"} as t) -> - (fun k -> - match Active.has_before_marker active_formatting_elements "a" with - | None -> k () - | Some existing -> - misnested_tag l t "a" (fun () -> - adoption_agency_algorithm l "a" (fun () -> - Stack.remove open_elements existing; - Active.remove active_formatting_elements existing; - k ()))) - (fun () -> + pop_implied l (fun () -> + (fun next -> + match Stack.current_element open_elements with + | Some { element_name = `HTML, name' } + when list_mem_string name' + [ "h1"; "h2"; "h3"; "h4"; "h5"; "h6" ] -> + next () + | _ -> report l (`Unmatched_end_tag name) !throw next) + @@ fun () -> + pop_until_and_raise_errors + [ "h1"; "h2"; "h3"; "h4"; "h5"; "h6" ] + l mode) + | l, `Start ({ name = "a" } as t) -> + (fun k -> + match Active.has_before_marker active_formatting_elements "a" with + | None -> k () + | Some existing -> + misnested_tag l t "a" (fun () -> + adoption_agency_algorithm l "a" (fun () -> + Stack.remove open_elements existing; + Active.remove active_formatting_elements existing; + k ()))) (fun () -> + Subtree.enable subtree_buffer; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~formatting:true l t mode)) + | ( l, + `Start + ({ + name = + ( "b" | "big" | "code" | "em" | "font" | "i" | "s" | "small" + | "strike" | "strong" | "tt" | "u" ); + } as t) ) -> Subtree.enable subtree_buffer; reconstruct_active_formatting_elements (fun () -> - push_and_emit ~formatting:true l t mode)) - - | l, `Start ({name = - "b" | "big" | "code" | "em" | "font" | "i" | "s" | "small" | - "strike" | "strong" | "tt" | "u"} as t) -> - Subtree.enable subtree_buffer; - reconstruct_active_formatting_elements (fun () -> - push_and_emit ~formatting:true l t mode) - - | l, `Start ({name = "nobr"} as t) -> - Subtree.enable subtree_buffer; - reconstruct_active_formatting_elements (fun () -> - (fun k -> - if not @@ Stack.in_scope open_elements "nobr" then k () - else - misnested_tag l t "nobr" (fun () -> - adoption_agency_algorithm l "nobr" (fun () -> - reconstruct_active_formatting_elements k))) - (fun () -> push_and_emit ~formatting:true l t mode)) - - | l, `End {name = - "a" | "b" | "big" | "code" | "em" | "font" | "i" | "nobr" | "s" | - "small" | "strike" | "strong" | "tt" | "u" as name} -> - adoption_agency_algorithm l name mode - - | l, `Start ({name = "applet" | "marquee" | "object"} as t) -> - frameset_ok := false; - reconstruct_active_formatting_elements (fun () -> - Active.add_marker active_formatting_elements; - push_and_emit l t mode) - - | l, `End {name = "applet" | "marquee" | "object" as name} -> - if not @@ Stack.in_scope open_elements name then - report l (`Unmatched_end_tag name) !throw mode - else begin - Active.clear_until_marker active_formatting_elements; - close_element_with_implied name l mode - end - - | l, `Start ({name = "table"} as t) -> - frameset_ok := false; - close_current_p_element l (fun () -> - push_and_emit l t in_table_mode) - - | l, `End {name = "br"} -> - report l (`Unmatched_end_tag "br") !throw (fun () -> - in_body_mode_rules context_name mode - (l, `Start - {Token_tag.name = "br"; attributes = []; self_closing = false})) - - | l, `Start ({name = - "area" | "br" | "embed" | "img" | "keygen" | "wbr"} as t) -> - frameset_ok := false; - reconstruct_active_formatting_elements (fun () -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l mode)) - - | l, `Start ({name = "input"} as t) -> - if Element.is_not_hidden t then frameset_ok := false; - reconstruct_active_formatting_elements (fun () -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l mode)) - - | l, `Start ({name = "param" | "source" | "track"} as t) -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l mode) - - | l, `Start ({name = "hr"} as t) -> - frameset_ok := false; - close_current_p_element l (fun () -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l mode)) - - | l, `Start ({name = "image"} as t) -> - report l (`Bad_token ("image", "tag", "should be 'img'")) !throw - (fun () -> - push tokens (l, `Start {t with name = "img"}); - mode ()) - - | l, `Start ({name = "textarea"} as t) -> - frameset_ok := false; - push_and_emit l t (fun () -> - set_tokenizer_state `RCDATA; - next_expected tokens !throw (function - | _, `Char 0x000A -> text_mode mode - | loc, `String s when String.starts_with ~prefix:"\n" s -> push tokens (loc, `String (String.sub s 1 (String.length s - 1))); text_mode mode - | v -> - push tokens v; - text_mode mode)) - - | l, `Start {name = "xmp"} -> - frameset_ok := false; - close_current_p_element l (fun () -> - reconstruct_active_formatting_elements (fun () -> - parse_rawtext mode)) - - | l, `Start ({name = "iframe"} as t) -> - frameset_ok := false; - push_and_emit l t (fun () -> - parse_rawtext mode) - - | l, `Start ({name = "noembed"} as t) -> - push_and_emit l t (fun () -> - parse_rawtext mode) - - | l, `Start ({name = "select"} as t) -> - frameset_ok := false; - select_in_body l t in_select_mode - - | l, `Start ({name = "optgroup" | "option"} as t) -> - (fun mode' -> - if Stack.current_element_is open_elements ["option"] then - pop l mode' - else mode' ()) - (fun () -> + push_and_emit ~formatting:true l t mode) + | l, `Start ({ name = "nobr" } as t) -> + Subtree.enable subtree_buffer; reconstruct_active_formatting_elements (fun () -> - push_and_emit l t mode)) - - | l, `Start ({name = "rb" | "rtc"} as t) -> - (fun mode' -> - let finish () = - if Stack.current_element_is open_elements ["ruby"] then - mode' () - else - misnested_tag l t context_name mode' - in - if Stack.in_scope open_elements "ruby" then - pop_implied l finish - else - finish ()) - (fun () -> - push_and_emit l t mode) - - | l, `Start ({name = "rp" | "rt"} as t) -> - (fun mode' -> - let finish () = - if Stack.current_element_is open_elements ["ruby"; "rtc"] then - mode' () - else - misnested_tag l t context_name mode' - in - if Stack.in_scope open_elements "ruby" then - pop_implied ~except:"rtc" l finish - else - finish ()) - (fun () -> - push_and_emit l t mode) - - | l, `Start ({name = "math"} as t) -> - reconstruct_active_formatting_elements (fun () -> - push_and_emit ~acknowledge:true ~namespace:`MathML l t (fun () -> - if t.self_closing then pop l mode - else mode ())) - - | l, `Start ({name = "svg"} as t) -> - reconstruct_active_formatting_elements (fun () -> - push_and_emit ~acknowledge:true ~namespace:`SVG l t (fun () -> - if t.self_closing then pop l mode - else mode ())) - - | l, `Start ({name = - "caption" | "col" | "colgroup" | "frame" | "head" | "tbody" | "td" | - "tfoot" | "th" | "thead" | "tr"} as t) -> - misnested_tag l t context_name mode - + (fun k -> + if not @@ Stack.in_scope open_elements "nobr" then k () + else + misnested_tag l t "nobr" (fun () -> + adoption_agency_algorithm l "nobr" (fun () -> + reconstruct_active_formatting_elements k))) (fun () -> + push_and_emit ~formatting:true l t mode)) + | ( l, + `End + { + name = + ( "a" | "b" | "big" | "code" | "em" | "font" | "i" | "nobr" | "s" + | "small" | "strike" | "strong" | "tt" | "u" ) as name; + } ) -> + adoption_agency_algorithm l name mode + | l, `Start ({ name = "applet" | "marquee" | "object" } as t) -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + Active.add_marker active_formatting_elements; + push_and_emit l t mode) + | l, `End { name = ("applet" | "marquee" | "object") as name } -> + if not @@ Stack.in_scope open_elements name then + report l (`Unmatched_end_tag name) !throw mode + else begin + Active.clear_until_marker active_formatting_elements; + close_element_with_implied name l mode + end + | l, `Start ({ name = "table" } as t) -> + frameset_ok := false; + close_current_p_element l (fun () -> push_and_emit l t in_table_mode) + | l, `End { name = "br" } -> + report l (`Unmatched_end_tag "br") !throw (fun () -> + in_body_mode_rules context_name mode + ( l, + `Start + { + Token_tag.name = "br"; + attributes = []; + self_closing = false; + } )) + | ( l, + `Start + ({ name = "area" | "br" | "embed" | "img" | "keygen" | "wbr" } as t) ) + -> + frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> pop l mode)) + | l, `Start ({ name = "input" } as t) -> + if Element.is_not_hidden t then frameset_ok := false; + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> pop l mode)) + | l, `Start ({ name = "param" | "source" | "track" } as t) -> + push_and_emit ~acknowledge:true l t (fun () -> pop l mode) + | l, `Start ({ name = "hr" } as t) -> + frameset_ok := false; + close_current_p_element l (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> pop l mode)) + | l, `Start ({ name = "image" } as t) -> + report l + (`Bad_token ("image", "tag", "should be 'img'")) + !throw + (fun () -> + push tokens (l, `Start { t with name = "img" }); + mode ()) + | l, `Start ({ name = "textarea" } as t) -> + frameset_ok := false; + push_and_emit l t (fun () -> + set_tokenizer_state `RCDATA; + next_expected tokens !throw (function + | _, `Char 0x000A -> text_mode mode + | loc, `String s when String.starts_with ~prefix:"\n" s -> + push tokens + (loc, `String (String.sub s 1 (String.length s - 1))); + text_mode mode + | v -> + push tokens v; + text_mode mode)) + | l, `Start { name = "xmp" } -> + frameset_ok := false; + close_current_p_element l (fun () -> + reconstruct_active_formatting_elements (fun () -> + parse_rawtext mode)) + | l, `Start ({ name = "iframe" } as t) -> + frameset_ok := false; + push_and_emit l t (fun () -> parse_rawtext mode) + | l, `Start ({ name = "noembed" } as t) -> + push_and_emit l t (fun () -> parse_rawtext mode) + | l, `Start ({ name = "select" } as t) -> + frameset_ok := false; + select_in_body l t in_select_mode + | l, `Start ({ name = "optgroup" | "option" } as t) -> + (fun mode' -> + if Stack.current_element_is open_elements [ "option" ] then + pop l mode' + else mode' ()) (fun () -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t mode)) + | l, `Start ({ name = "rb" | "rtc" } as t) -> + (fun mode' -> + let finish () = + if Stack.current_element_is open_elements [ "ruby" ] then mode' () + else misnested_tag l t context_name mode' + in + if Stack.in_scope open_elements "ruby" then pop_implied l finish + else finish ()) (fun () -> push_and_emit l t mode) + | l, `Start ({ name = "rp" | "rt" } as t) -> + (fun mode' -> + let finish () = + if Stack.current_element_is open_elements [ "ruby"; "rtc" ] then + mode' () + else misnested_tag l t context_name mode' + in + if Stack.in_scope open_elements "ruby" then + pop_implied ~except:"rtc" l finish + else finish ()) (fun () -> push_and_emit l t mode) + | l, `Start ({ name = "math" } as t) -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true ~namespace:`MathML l t (fun () -> + if t.self_closing then pop l mode else mode ())) + | l, `Start ({ name = "svg" } as t) -> + reconstruct_active_formatting_elements (fun () -> + push_and_emit ~acknowledge:true ~namespace:`SVG l t (fun () -> + if t.self_closing then pop l mode else mode ())) + | ( l, + `Start + ({ + name = + ( "caption" | "col" | "colgroup" | "frame" | "head" | "tbody" + | "td" | "tfoot" | "th" | "thead" | "tr" ); + } as t) ) -> + misnested_tag l t context_name mode | l, `Start t -> - reconstruct_active_formatting_elements (fun () -> - push_and_emit l t mode) - - | l, `End {name} -> - any_other_end_tag_in_body l name mode - + reconstruct_active_formatting_elements (fun () -> + push_and_emit l t mode) + | l, `End { name } -> any_other_end_tag_in_body l name mode (* Part of 8.2.5.4.7. *) and any_other_end_tag_in_body l name mode = let rec close = function | [] -> mode () - | {element_name = (ns, name') as name''}::rest -> - if ns = `HTML && name' = name then - pop_implied ~except:name l (fun () -> - pop l mode) - else - if Element.is_special name'' then + | { element_name = (ns, name') as name'' } :: rest -> + if ns = `HTML && name' = name then + pop_implied ~except:name l (fun () -> pop l mode) + else if Element.is_special name'' then report l (`Unmatched_end_tag name) !throw mode else close rest in close !(Stack.elements open_elements) - (* Part of 8.2.5.4.7. *) and adoption_agency_algorithm l name mode = Subtree.enable subtree_buffer; emit_text (fun () -> - let handled, errors = - Subtree.adoption_agency_algorithm - subtree_buffer active_formatting_elements l name - in - let rec report_all errors k = - match errors with - | [] -> k () - | (l, error)::more -> - report l error !throw (fun () -> report_all more k) - in - report_all errors (fun () -> - if not handled then any_other_end_tag_in_body l name mode - else mode ())) - + let handled, errors = + Subtree.adoption_agency_algorithm subtree_buffer + active_formatting_elements l name + in + let rec report_all errors k = + match errors with + | [] -> k () + | (l, error) :: more -> + report l error !throw (fun () -> report_all more k) + in + report_all errors (fun () -> + if not handled then any_other_end_tag_in_body l name mode + else mode ())) (* Part of 8.2.5.4.7. *) and select_in_body l t next_mode = frameset_ok := false; reconstruct_active_formatting_elements (fun () -> - push_and_emit l t next_mode) - + push_and_emit l t next_mode) (* 8.2.5.4.8. *) and text_mode original_mode = dispatch tokens begin function - | l, `Char c -> - add_character l c; - text_mode original_mode - - | l, `String s -> - add_string l s; - text_mode original_mode - - | l, `EOF as v -> - report l (`Unexpected_eoi "content") !throw (fun () -> - push tokens v; - pop l original_mode) - - | l, `End _ -> - pop l original_mode - - | _ -> - text_mode original_mode - end - + | l, `Char c -> + add_character l c; + text_mode original_mode + | l, `String s -> + add_string l s; + text_mode original_mode + | (l, `EOF) as v -> + report l (`Unexpected_eoi "content") !throw (fun () -> + push tokens v; + pop l original_mode) + | l, `End _ -> pop l original_mode + | _ -> text_mode original_mode + end (* 8.2.5.2. *) and parse_rcdata original_mode = set_tokenizer_state `RCDATA; text_mode original_mode - (* 8.2.5.2. *) and parse_rawtext original_mode = set_tokenizer_state `RAWTEXT; text_mode original_mode - - and anything_else_in_table mode (l, _ as v) = + and anything_else_in_table mode ((l, _) as v) = report l (`Bad_content "table") !throw (fun () -> - in_body_mode_rules "table" mode v) - + in_body_mode_rules "table" mode v) (* 8.2.5.4.9. *) and in_table_mode () = dispatch tokens (fun v -> in_table_mode_rules in_table_mode v) - and in_table_mode_rules mode = function - | (_, `Char _| _, `String _) as v - when Stack.current_element_is open_elements - ["table"; "tbody"; "tfoot"; "thead"; "tr"] -> - push tokens v; - in_table_text_mode true [] mode - - | l, `Comment s -> - emit l (`Comment s) mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw mode - - | l, `Start ({name = "caption"} as t) -> - pop_to_table_context l (fun () -> - Active.add_marker active_formatting_elements; - push_and_emit l t in_caption_mode) - - | l, `Start ({name = "colgroup"} as t) -> - pop_to_table_context l (fun () -> - push_and_emit l t in_column_group_mode) - - | l, `Start {name = "col"} as v -> - pop_to_table_context l (fun () -> - push tokens v; - push_implicit l "colgroup" in_column_group_mode) - - | l, `Start ({name = "tbody" | "tfoot" | "thead"} as t) -> - pop_to_table_context l (fun () -> - push_and_emit l t in_table_body_mode) - - | l, `Start {name = "td" | "th" | "tr"} as v -> - pop_to_table_context l (fun () -> - push tokens v; - push_implicit l "tbody" in_table_body_mode) - - | l, `Start ({name = "table"} as t) as v -> - misnested_tag l t "table" (fun () -> - if not @@ Stack.has open_elements "table" then mode () - else begin + | (_, `Char _ | _, `String _) as v + when Stack.current_element_is open_elements + [ "table"; "tbody"; "tfoot"; "thead"; "tr" ] -> push tokens v; - close_element l "table" (fun () -> reset_mode () ()) - end) - - | l, `End {name = "table"} -> - if not @@ Stack.in_table_scope open_elements "table" then - report l (`Unmatched_end_tag "table") !throw mode - else - close_element l "table" (fun () -> reset_mode () ()) - - | l, `End {name = - "body" | "caption" | "col" | "colgroup" | "html" | "tbody" | "td" | - "tfoot" | "th" | "thead" | "tr" as name} -> - report l (`Unmatched_end_tag name) !throw mode - - | _, `Start {name = "style" | "script" | "template"} - | _, `End {name = "template"} as v -> - in_head_mode_rules mode v - - | l, `Start ({name = "input"} as t) when Element.is_not_hidden t -> - misnested_tag l t "table" (fun () -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l mode)) - - | l, `Start ({name = "form"} as t) -> - misnested_tag l t "table" (fun () -> - push_and_emit l t (fun () -> - pop l mode)) - - | _, `EOF as v -> - in_body_mode_rules "table" mode v - - | v -> - anything_else_in_table mode v - + in_table_text_mode true [] mode + | l, `Comment s -> emit l (`Comment s) mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + | l, `Start ({ name = "caption" } as t) -> + pop_to_table_context l (fun () -> + Active.add_marker active_formatting_elements; + push_and_emit l t in_caption_mode) + | l, `Start ({ name = "colgroup" } as t) -> + pop_to_table_context l (fun () -> + push_and_emit l t in_column_group_mode) + | (l, `Start { name = "col" }) as v -> + pop_to_table_context l (fun () -> + push tokens v; + push_implicit l "colgroup" in_column_group_mode) + | l, `Start ({ name = "tbody" | "tfoot" | "thead" } as t) -> + pop_to_table_context l (fun () -> push_and_emit l t in_table_body_mode) + | (l, `Start { name = "td" | "th" | "tr" }) as v -> + pop_to_table_context l (fun () -> + push tokens v; + push_implicit l "tbody" in_table_body_mode) + | (l, `Start ({ name = "table" } as t)) as v -> + misnested_tag l t "table" (fun () -> + if not @@ Stack.has open_elements "table" then mode () + else begin + push tokens v; + close_element l "table" (fun () -> reset_mode () ()) + end) + | l, `End { name = "table" } -> + if not @@ Stack.in_table_scope open_elements "table" then + report l (`Unmatched_end_tag "table") !throw mode + else close_element l "table" (fun () -> reset_mode () ()) + | ( l, + `End + { + name = + ( "body" | "caption" | "col" | "colgroup" | "html" | "tbody" + | "td" | "tfoot" | "th" | "thead" | "tr" ) as name; + } ) -> + report l (`Unmatched_end_tag name) !throw mode + | ( _, `Start { name = "style" | "script" | "template" } + | _, `End { name = "template" } ) as v -> + in_head_mode_rules mode v + | l, `Start ({ name = "input" } as t) when Element.is_not_hidden t -> + misnested_tag l t "table" (fun () -> + push_and_emit ~acknowledge:true l t (fun () -> pop l mode)) + | l, `Start ({ name = "form" } as t) -> + misnested_tag l t "table" (fun () -> + push_and_emit l t (fun () -> pop l mode)) + | (_, `EOF) as v -> in_body_mode_rules "table" mode v + | v -> anything_else_in_table mode v (* 8.2.5.4.10. *) and in_table_text_mode only_space cs mode = dispatch tokens begin function - | l, `Char 0 -> - report l (`Bad_token ("U+0000", "table", "null")) !throw (fun () -> - in_table_text_mode only_space cs mode) - - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as v -> - in_table_text_mode only_space (v::cs) mode - - | _, `Char _ as v -> - in_table_text_mode false (v::cs) mode - - | (_, `String s as v) when is_whitespace_only s -> - in_table_text_mode only_space (v::cs) mode - - | _, `String _ as v -> - in_table_text_mode false (v::cs) mode - - | v -> - push tokens v; - if not only_space then - let rec reprocess = function - | [] -> mode () - | v::more -> anything_else_in_table (fun () -> reprocess more) v - in - reprocess (List.rev cs) - else begin - List.rev cs |> List.iter (function - | l, `Char c -> add_character l c - | _ -> ()); - mode () - end - end - + | l, `Char 0 -> + report l + (`Bad_token ("U+0000", "table", "null")) + !throw + (fun () -> in_table_text_mode only_space cs mode) + | (_, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020)) as v -> + in_table_text_mode only_space (v :: cs) mode + | (_, `Char _) as v -> in_table_text_mode false (v :: cs) mode + | (_, `String s) as v when is_whitespace_only s -> + in_table_text_mode only_space (v :: cs) mode + | (_, `String _) as v -> in_table_text_mode false (v :: cs) mode + | v -> + push tokens v; + if not only_space then + let rec reprocess = function + | [] -> mode () + | v :: more -> + anything_else_in_table (fun () -> reprocess more) v + in + reprocess (List.rev cs) + else begin + List.rev cs + |> List.iter (function + | l, `Char c -> add_character l c + | _ -> ()); + mode () + end + end (* 8.2.5.4.11. *) and in_caption_mode () = dispatch tokens begin function - | l, `End {name = "caption"} -> - if not @@ Stack.in_table_scope open_elements "caption" then - report l (`Unmatched_end_tag "caption") !throw in_caption_mode - else begin - Active.clear_until_marker active_formatting_elements; - close_element_with_implied "caption" l in_table_mode - end - - | l, `Start ({name = - "caption" | "col" | "colgroup" | "tbody" | "td" | "tfoot" | "th" | - "thead" | "tr"} as t) as v -> - misnested_tag l t "caption" (fun () -> - if not @@ Stack.in_table_scope open_elements "caption" then - in_caption_mode () - else begin - Active.clear_until_marker active_formatting_elements; - push tokens v; - close_element l "caption" in_table_mode - end) - - | l, `End {name = "table"} as v -> - report l (`Unmatched_end_tag "table") !throw (fun () -> - if not @@ Stack.in_table_scope open_elements "caption" then - in_caption_mode () - else begin - Active.clear_until_marker active_formatting_elements; - push tokens v; - close_element l "caption" in_table_mode - end) - - | l, `End {name = - ("body" | "col" | "colgroup" | "html" | "tbody" | "td" | "tfoot" | - "th" | "thead" | "tr") as name} -> - report l (`Unmatched_end_tag name) !throw in_caption_mode - - | l, `Start ({name = "select"} as t) -> - select_in_body l t in_select_in_table_mode - - | v -> - in_body_mode_rules "caption" in_caption_mode v - end - + | l, `End { name = "caption" } -> + if not @@ Stack.in_table_scope open_elements "caption" then + report l (`Unmatched_end_tag "caption") !throw in_caption_mode + else begin + Active.clear_until_marker active_formatting_elements; + close_element_with_implied "caption" l in_table_mode + end + | ( l, + `Start + ({ + name = + ( "caption" | "col" | "colgroup" | "tbody" | "td" | "tfoot" + | "th" | "thead" | "tr" ); + } as t) ) as v -> + misnested_tag l t "caption" (fun () -> + if not @@ Stack.in_table_scope open_elements "caption" then + in_caption_mode () + else begin + Active.clear_until_marker active_formatting_elements; + push tokens v; + close_element l "caption" in_table_mode + end) + | (l, `End { name = "table" }) as v -> + report l (`Unmatched_end_tag "table") !throw (fun () -> + if not @@ Stack.in_table_scope open_elements "caption" then + in_caption_mode () + else begin + Active.clear_until_marker active_formatting_elements; + push tokens v; + close_element l "caption" in_table_mode + end) + | ( l, + `End + { + name = + ( "body" | "col" | "colgroup" | "html" | "tbody" | "td" + | "tfoot" | "th" | "thead" | "tr" ) as name; + } ) -> + report l (`Unmatched_end_tag name) !throw in_caption_mode + | l, `Start ({ name = "select" } as t) -> + select_in_body l t in_select_in_table_mode + | v -> in_body_mode_rules "caption" in_caption_mode v + end (* 8.2.5.4.12. *) and in_column_group_mode () = dispatch tokens begin function - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - add_character l c; - in_column_group_mode () - - | l, `String s when is_whitespace_only s -> - add_string l s; - in_column_group_mode () - - | l, `Comment s -> - emit l (`Comment s) in_column_group_mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - in_column_group_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "colgroup" in_column_group_mode v - - | l, `Start ({name = "col"} as t) -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l in_column_group_mode) - - | l, `End {name = "colgroup"} -> - if not @@ Stack.current_element_is open_elements ["colgroup"] then - report l (`Unmatched_end_tag "colgroup") !throw in_column_group_mode - else - pop l in_table_mode - - | l, `End {name = "col"} -> - report l (`Unmatched_end_tag "col") !throw in_column_group_mode - - | _, `Start {name = "template"} - | _, `End {name = "template"} as v -> - in_head_mode_rules in_column_group_mode v - - | _, `EOF as v -> - in_body_mode_rules "colgroup" in_column_group_mode v - - | l, _ as v -> - if not @@ Stack.current_element_is open_elements ["colgroup"] then - report l (`Bad_content "colgroup") !throw in_table_mode - else begin - push tokens v; - pop l in_table_mode - end - end - + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + add_character l c; + in_column_group_mode () + | l, `String s when is_whitespace_only s -> + add_string l s; + in_column_group_mode () + | l, `Comment s -> emit l (`Comment s) in_column_group_mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + in_column_group_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "colgroup" in_column_group_mode v + | l, `Start ({ name = "col" } as t) -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l in_column_group_mode) + | l, `End { name = "colgroup" } -> + if not @@ Stack.current_element_is open_elements [ "colgroup" ] then + report l (`Unmatched_end_tag "colgroup") !throw + in_column_group_mode + else pop l in_table_mode + | l, `End { name = "col" } -> + report l (`Unmatched_end_tag "col") !throw in_column_group_mode + | (_, `Start { name = "template" } | _, `End { name = "template" }) as v + -> + in_head_mode_rules in_column_group_mode v + | (_, `EOF) as v -> in_body_mode_rules "colgroup" in_column_group_mode v + | (l, _) as v -> + if not @@ Stack.current_element_is open_elements [ "colgroup" ] then + report l (`Bad_content "colgroup") !throw in_table_mode + else begin + push tokens v; + pop l in_table_mode + end + end (* 8.2.5.4.13. *) and in_table_body_mode () = dispatch tokens begin function - | l, `Start ({name = "tr"} as t) -> - pop_to_table_body_context l (fun () -> - push_and_emit l t in_row_mode) - - | l, `Start ({name = "th" | "td"} as t) as v -> - misnested_tag l t "table" (fun () -> - pop_to_table_body_context l (fun () -> - push tokens v; - push_implicit l "tr" in_row_mode)) - - | l, `End {name = "tbody" | "tfoot" | "thead" as name} -> - if not @@ Stack.in_table_scope open_elements name then - report l (`Unmatched_end_tag name) !throw in_table_body_mode - else - pop_to_table_body_context l (fun () -> - pop l in_table_mode) - - | l, `Start ({name = - "caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead"} as t) - as v -> - if not @@ Stack.one_in_table_scope open_elements - ["tbody"; "thead"; "tfoot"] then - misnested_tag l t "table" in_table_body_mode - else begin - push tokens v; - pop_to_table_body_context l (fun () -> - pop l in_table_mode) - end - - | l, `End {name = "table" as name} as v -> - if not @@ Stack.one_in_table_scope open_elements - ["tbody"; "thead"; "tfoot"] then - report l (`Unmatched_end_tag name) !throw in_table_body_mode - else begin - push tokens v; - pop_to_table_body_context l (fun () -> - pop l in_table_mode) - end - - | l, `End {name = - "body" | "caption" | "col" | "colgroup" | "html" | "td" | "th" | - "tr" as name} -> - report l (`Unmatched_end_tag name) !throw in_table_body_mode - - | v -> - in_table_mode_rules in_table_body_mode v - end - + | l, `Start ({ name = "tr" } as t) -> + pop_to_table_body_context l (fun () -> + push_and_emit l t in_row_mode) + | (l, `Start ({ name = "th" | "td" } as t)) as v -> + misnested_tag l t "table" (fun () -> + pop_to_table_body_context l (fun () -> + push tokens v; + push_implicit l "tr" in_row_mode)) + | l, `End { name = ("tbody" | "tfoot" | "thead") as name } -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_table_body_mode + else pop_to_table_body_context l (fun () -> pop l in_table_mode) + | ( l, + `Start + ({ + name = + "caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead"; + } as t) ) as v -> + if + not + @@ Stack.one_in_table_scope open_elements + [ "tbody"; "thead"; "tfoot" ] + then misnested_tag l t "table" in_table_body_mode + else begin + push tokens v; + pop_to_table_body_context l (fun () -> pop l in_table_mode) + end + | (l, `End { name = "table" as name }) as v -> + if + not + @@ Stack.one_in_table_scope open_elements + [ "tbody"; "thead"; "tfoot" ] + then report l (`Unmatched_end_tag name) !throw in_table_body_mode + else begin + push tokens v; + pop_to_table_body_context l (fun () -> pop l in_table_mode) + end + | ( l, + `End + { + name = + ( "body" | "caption" | "col" | "colgroup" | "html" | "td" + | "th" | "tr" ) as name; + } ) -> + report l (`Unmatched_end_tag name) !throw in_table_body_mode + | v -> in_table_mode_rules in_table_body_mode v + end (* 8.2.5.4.14. *) and in_row_mode () = dispatch tokens begin function - | l, `Start ({name = "th" | "td"} as t) -> - Active.add_marker active_formatting_elements; - pop_to_table_row_context l (fun () -> - push_and_emit l t in_cell_mode) - - | l, `End {name = "tr"} -> - if not @@ Stack.in_table_scope open_elements "tr" then - report l (`Unmatched_end_tag "tr") !throw in_row_mode - else - pop_to_table_row_context l (fun () -> - pop l in_table_body_mode) - - | l, `Start {name = - ("caption" | "col" | "colgroup" | "tbody" | "tfoot" | "thead" | - "tr")} - | l, `End {name = "table"} as v -> - if not @@ Stack.in_table_scope open_elements "tr" then - match snd v with - | `Start t -> - misnested_tag l t "tr" in_row_mode - | `End {name} -> - report l (`Unmatched_end_tag name) !throw in_row_mode - else - pop_to_table_row_context l (fun () -> - push tokens v; - pop l in_table_body_mode) - - | l, `End {name = "tbody" | "tfoot" | "thead" as name} as v -> - if not @@ Stack.in_table_scope open_elements name then - report l (`Unmatched_end_tag name) !throw in_row_mode - else - if not @@ Stack.in_table_scope open_elements "tr" then in_row_mode () - else + | l, `Start ({ name = "th" | "td" } as t) -> + Active.add_marker active_formatting_elements; pop_to_table_row_context l (fun () -> - push tokens v; - pop l in_table_body_mode) - - | l, `End {name = - "body" | "caption" | "col" | "colgroup" | "html" | "td" | "th" - as name} -> - report l (`Unmatched_end_tag name) !throw in_row_mode - - | v -> - in_table_mode_rules in_row_mode v - end - + push_and_emit l t in_cell_mode) + | l, `End { name = "tr" } -> + if not @@ Stack.in_table_scope open_elements "tr" then + report l (`Unmatched_end_tag "tr") !throw in_row_mode + else pop_to_table_row_context l (fun () -> pop l in_table_body_mode) + | ( ( l, + `Start + { + name = + ( "caption" | "col" | "colgroup" | "tbody" | "tfoot" + | "thead" | "tr" ); + } ) + | l, `End { name = "table" } ) as v -> + if not @@ Stack.in_table_scope open_elements "tr" then + match snd v with + | `Start t -> misnested_tag l t "tr" in_row_mode + | `End { name } -> + report l (`Unmatched_end_tag name) !throw in_row_mode + else + pop_to_table_row_context l (fun () -> + push tokens v; + pop l in_table_body_mode) + | (l, `End { name = ("tbody" | "tfoot" | "thead") as name }) as v -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_row_mode + else if not @@ Stack.in_table_scope open_elements "tr" then + in_row_mode () + else + pop_to_table_row_context l (fun () -> + push tokens v; + pop l in_table_body_mode) + | ( l, + `End + { + name = + ( "body" | "caption" | "col" | "colgroup" | "html" | "td" + | "th" ) as name; + } ) -> + report l (`Unmatched_end_tag name) !throw in_row_mode + | v -> in_table_mode_rules in_row_mode v + end (* 8.2.5.4.15. *) and in_cell_mode () = dispatch tokens begin function - | l, `End {name = "td" | "th" as name} -> - if not @@ Stack.in_table_scope open_elements name then - report l (`Unmatched_end_tag name) !throw in_cell_mode - else - close_element_with_implied name l (fun () -> - Active.clear_until_marker active_formatting_elements; - in_row_mode ()) - - | l, `Start ({name = - "caption" | "col" | "colgroup" | "tbody" | "td" | "tfoot" | "th" | - "thead" | "tr"} as t) as v -> - if not @@ Stack.one_in_table_scope open_elements ["td"; "th"] then - misnested_tag l t "td/th" in_cell_mode - else - close_cell l (fun () -> - Active.clear_until_marker active_formatting_elements; - push tokens v; - in_row_mode ()) - - | l, `End {name = - "body" | "caption" | "col" | "colgroup" | "html" as name} -> - report l (`Unmatched_end_tag name) !throw in_cell_mode - - | l, `End {name = - "table" | "tbody" | "tfoot" | "thead" | "tr" as name} as v -> - if not @@ Stack.in_table_scope open_elements name then - report l (`Unmatched_end_tag name) !throw in_cell_mode - else - close_cell l (fun () -> - Active.clear_until_marker active_formatting_elements; - push tokens v; - in_row_mode ()) - - | l, `Start ({name = "select"} as t) -> - select_in_body l t in_select_in_table_mode - - | v -> - in_body_mode_rules "td" in_cell_mode v - end - + | l, `End { name = ("td" | "th") as name } -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_cell_mode + else + close_element_with_implied name l (fun () -> + Active.clear_until_marker active_formatting_elements; + in_row_mode ()) + | ( l, + `Start + ({ + name = + ( "caption" | "col" | "colgroup" | "tbody" | "td" | "tfoot" + | "th" | "thead" | "tr" ); + } as t) ) as v -> + if not @@ Stack.one_in_table_scope open_elements [ "td"; "th" ] then + misnested_tag l t "td/th" in_cell_mode + else + close_cell l (fun () -> + Active.clear_until_marker active_formatting_elements; + push tokens v; + in_row_mode ()) + | ( l, + `End + { + name = + ("body" | "caption" | "col" | "colgroup" | "html") as name; + } ) -> + report l (`Unmatched_end_tag name) !throw in_cell_mode + | ( l, + `End + { name = ("table" | "tbody" | "tfoot" | "thead" | "tr") as name } + ) as v -> + if not @@ Stack.in_table_scope open_elements name then + report l (`Unmatched_end_tag name) !throw in_cell_mode + else + close_cell l (fun () -> + Active.clear_until_marker active_formatting_elements; + push tokens v; + in_row_mode ()) + | l, `Start ({ name = "select" } as t) -> + select_in_body l t in_select_in_table_mode + | v -> in_body_mode_rules "td" in_cell_mode v + end (* 8.2.5.4.16. *) and in_select_mode () = dispatch tokens (fun v -> in_select_mode_rules in_select_mode v) - and in_select_mode_rules mode = function | l, `Char 0 -> - report l (`Bad_token ("U+0000", "select", "null")) !throw mode - + report l (`Bad_token ("U+0000", "select", "null")) !throw mode | l, `Char c -> - add_character l c; - mode () - + add_character l c; + mode () | l, `String s -> - add_string l s; - mode () - - | l, `Comment s -> - emit l (`Comment s) mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "select" mode v - - | l, `Start ({name = "option"} as t) -> - (fun mode' -> - if Stack.current_element_is open_elements ["option"] then pop l mode' - else mode' ()) - (fun () -> push_and_emit l t mode) - - | l, `Start ({name = "optgroup"} as t) -> - (fun mode' -> - if Stack.current_element_is open_elements ["option"] then pop l mode' - else mode' ()) - @@ (fun mode' () -> - if Stack.current_element_is open_elements ["optgroup"] then pop l mode' - else mode' ()) - @@ (fun () -> push_and_emit l t mode) - - | l, `End {name = "optgroup"} -> - (fun mode' -> - match !(Stack.elements open_elements) with - | {element_name = `HTML, "option"}:: - {element_name = `HTML, "optgroup"}::_ -> - pop l mode' - | _ -> mode' ()) - (fun () -> - if Stack.current_element_is open_elements ["optgroup"] then - pop l mode - else - report l (`Unmatched_end_tag "optgroup") !throw mode) - - | l, `End {name = "option"} -> - if Stack.current_element_is open_elements ["option"] then - pop l mode - else - report l (`Unmatched_end_tag "option") !throw mode - - | l, `End {name = "select"} -> - if not @@ Stack.in_select_scope open_elements "select" then - report l (`Unmatched_end_tag "select") !throw mode - else - close_element l "select" (fun () -> reset_mode () ()) - - | l, `Start ({name = "select"} as t) -> - misnested_tag l t "select" (fun () -> - close_element l "select" (fun () -> reset_mode () ())) - - | l, `Start ({name = "input" | "keygen" | "textarea"} as t) as v -> - misnested_tag l t "select" (fun () -> - if not @@ Stack.in_select_scope open_elements "select" then + add_string l s; mode () - else begin - push tokens v; - close_element l "select" (fun () -> reset_mode () ()) - end) - - | _, (`Start {name = "script" | "template"} | - `End {name = "template"}) as v -> - in_head_mode_rules mode v - - | _, `EOF as v -> - in_body_mode_rules "select" mode v - - | l, _ -> - report l (`Bad_content "select") !throw mode - + | l, `Comment s -> emit l (`Comment s) mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw mode + | (_, `Start { name = "html" }) as v -> in_body_mode_rules "select" mode v + | l, `Start ({ name = "option" } as t) -> + (fun mode' -> + if Stack.current_element_is open_elements [ "option" ] then + pop l mode' + else mode' ()) (fun () -> push_and_emit l t mode) + | l, `Start ({ name = "optgroup" } as t) -> + (fun mode' -> + if Stack.current_element_is open_elements [ "option" ] then + pop l mode' + else mode' ()) + @@ (fun mode' () -> + if Stack.current_element_is open_elements [ "optgroup" ] then + pop l mode' + else mode' ()) + @@ fun () -> push_and_emit l t mode + | l, `End { name = "optgroup" } -> + (fun mode' -> + match !(Stack.elements open_elements) with + | { element_name = `HTML, "option" } + :: { element_name = `HTML, "optgroup" } + :: _ -> + pop l mode' + | _ -> mode' ()) (fun () -> + if Stack.current_element_is open_elements [ "optgroup" ] then + pop l mode + else report l (`Unmatched_end_tag "optgroup") !throw mode) + | l, `End { name = "option" } -> + if Stack.current_element_is open_elements [ "option" ] then pop l mode + else report l (`Unmatched_end_tag "option") !throw mode + | l, `End { name = "select" } -> + if not @@ Stack.in_select_scope open_elements "select" then + report l (`Unmatched_end_tag "select") !throw mode + else close_element l "select" (fun () -> reset_mode () ()) + | l, `Start ({ name = "select" } as t) -> + misnested_tag l t "select" (fun () -> + close_element l "select" (fun () -> reset_mode () ())) + | (l, `Start ({ name = "input" | "keygen" | "textarea" } as t)) as v -> + misnested_tag l t "select" (fun () -> + if not @@ Stack.in_select_scope open_elements "select" then mode () + else begin + push tokens v; + close_element l "select" (fun () -> reset_mode () ()) + end) + | (_, (`Start { name = "script" | "template" } | `End { name = "template" })) + as v -> + in_head_mode_rules mode v + | (_, `EOF) as v -> in_body_mode_rules "select" mode v + | l, _ -> report l (`Bad_content "select") !throw mode (* 8.2.5.4.17. *) and in_select_in_table_mode () = dispatch tokens begin function - | l, `Start ({name = - "caption" | "table" | "tbody" | "tfoot" | "thead" | "tr" | "td" | - "th"} as t) as v -> - misnested_tag l t "table" (fun () -> - push tokens v; - close_element l "select" (fun () -> reset_mode () ())) - - | l, `End {name = - "caption" | "table" | "tbody" | "tfoot" | "thead" | "tr" | "td" | - "th" as name} as v -> - report l (`Unmatched_end_tag "name") !throw (fun () -> - if not @@ Stack.in_table_scope open_elements name then - in_select_in_table_mode () - else begin - push tokens v; - close_element l "select" (fun () -> reset_mode () ()) - end) - - | v -> - in_select_mode_rules in_select_in_table_mode v - end - + | ( l, + `Start + ({ + name = + ( "caption" | "table" | "tbody" | "tfoot" | "thead" | "tr" + | "td" | "th" ); + } as t) ) as v -> + misnested_tag l t "table" (fun () -> + push tokens v; + close_element l "select" (fun () -> reset_mode () ())) + | ( l, + `End + { + name = + ( "caption" | "table" | "tbody" | "tfoot" | "thead" | "tr" + | "td" | "th" ) as name; + } ) as v -> + report l (`Unmatched_end_tag "name") !throw (fun () -> + if not @@ Stack.in_table_scope open_elements name then + in_select_in_table_mode () + else begin + push tokens v; + close_element l "select" (fun () -> reset_mode () ()) + end) + | v -> in_select_mode_rules in_select_in_table_mode v + end (* 8.2.5.4.18. *) and in_template_mode () = dispatch tokens (fun v -> in_table_mode_rules in_template_mode v) - (* 8.2.5.4.18. *) and in_template_mode_rules mode = function - | _, (`Char _ | `Comment _ | `Doctype _ | `String _) as v -> - in_body_mode_rules "template" mode v - - | _, `Start {name = - "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" | - "script" | "style" | "template" | "title"} - | _, `End {name = "template"} as v -> - in_head_mode_rules mode v - - | _, `Start {name = - "caption" | "colgroup" | "tbody" | "tfoot" | "thead"} as v -> - Template.pop template_insertion_modes; - Template.push template_insertion_modes in_table_mode; - push tokens v; - in_table_mode () - - | _, `Start {name = "col"} as v -> - Template.pop template_insertion_modes; - Template.push template_insertion_modes in_column_group_mode; - push tokens v; - in_column_group_mode () - - | _, `Start {name = "tr"} as v -> - Template.pop template_insertion_modes; - Template.push template_insertion_modes in_table_body_mode; - push tokens v; - in_table_body_mode () - - | _, `Start {name = "td" | "th"} as v -> - Template.pop template_insertion_modes; - Template.push template_insertion_modes in_row_mode; - push tokens v; - in_row_mode () - - | _, `Start _ as v -> - Template.pop template_insertion_modes; - Template.push template_insertion_modes in_body_mode; - push tokens v; - in_body_mode () - - | l, `End {name} -> - report l (`Unmatched_end_tag name) !throw mode - - | l, `EOF as v -> - if not @@ Stack.has open_elements "template" then emit_end l - else begin - report l (`Unmatched_end_tag "template") !throw (fun () -> - Active.clear_until_marker active_formatting_elements; + | (_, (`Char _ | `Comment _ | `Doctype _ | `String _)) as v -> + in_body_mode_rules "template" mode v + | ( ( _, + `Start + { + name = + ( "base" | "basefont" | "bgsound" | "link" | "meta" | "noframes" + | "script" | "style" | "template" | "title" ); + } ) + | _, `End { name = "template" } ) as v -> + in_head_mode_rules mode v + | (_, `Start { name = "caption" | "colgroup" | "tbody" | "tfoot" | "thead" }) + as v -> Template.pop template_insertion_modes; + Template.push template_insertion_modes in_table_mode; push tokens v; - close_element l "template" (fun () -> reset_mode () ())) - end - + in_table_mode () + | (_, `Start { name = "col" }) as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_column_group_mode; + push tokens v; + in_column_group_mode () + | (_, `Start { name = "tr" }) as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_table_body_mode; + push tokens v; + in_table_body_mode () + | (_, `Start { name = "td" | "th" }) as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_row_mode; + push tokens v; + in_row_mode () + | (_, `Start _) as v -> + Template.pop template_insertion_modes; + Template.push template_insertion_modes in_body_mode; + push tokens v; + in_body_mode () + | l, `End { name } -> report l (`Unmatched_end_tag name) !throw mode + | (l, `EOF) as v -> + if not @@ Stack.has open_elements "template" then emit_end l + else begin + report l (`Unmatched_end_tag "template") !throw (fun () -> + Active.clear_until_marker active_formatting_elements; + Template.pop template_insertion_modes; + push tokens v; + close_element l "template" (fun () -> reset_mode () ())) + end (* 8.2.5.4.19. *) and after_body_mode () = dispatch tokens begin function - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as v -> - in_body_mode_rules "html" after_body_mode v - - | (_, `String s) as v when is_whitespace_only s -> - in_body_mode_rules "html" after_body_mode v - - | l, `Comment s -> - emit l (`Comment s) after_body_mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - after_body_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "html" after_body_mode v - - | _, `End {name = "html"} -> - after_after_body_mode () - - | l, `EOF -> - emit_end l - - | l, _ as v -> - report l (`Bad_document "content after body") !throw (fun () -> - push tokens v; - in_body_mode ()) - end - + | (_, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020)) as v -> + in_body_mode_rules "html" after_body_mode v + | (_, `String s) as v when is_whitespace_only s -> + in_body_mode_rules "html" after_body_mode v + | l, `Comment s -> emit l (`Comment s) after_body_mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + after_body_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "html" after_body_mode v + | _, `End { name = "html" } -> after_after_body_mode () + | l, `EOF -> emit_end l + | (l, _) as v -> + report l (`Bad_document "content after body") !throw (fun () -> + push tokens v; + in_body_mode ()) + end (* 8.2.5.4.20. *) and in_frameset_mode () = dispatch tokens begin function - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - add_character l c; - in_frameset_mode () - - | l, `String s when is_whitespace_only s -> - add_string l s; - in_frameset_mode () - - | l, `Comment s -> - emit l (`Comment s) in_frameset_mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - in_frameset_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "frameset" in_frameset_mode v - - | l, `Start ({name = "frameset"} as t) -> - push_and_emit l t in_frameset_mode - - | l, `End {name = "frameset"} -> - (fun mode' -> - if Stack.current_element_is open_elements ["html"] then - report l (`Unmatched_end_tag "frameset") !throw mode' - else - pop l mode') - (fun () -> - if Stack.current_element_is open_elements ["frameset"] then + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + add_character l c; in_frameset_mode () - else after_frameset_mode ()) - - | l, `Start ({name = "frame"} as t) -> - push_and_emit ~acknowledge:true l t (fun () -> - pop l in_frameset_mode) - - | _, `Start {name = "noframes"} as v -> - in_head_mode_rules in_frameset_mode v - - | l, `EOF -> - (fun mode' -> - if not @@ Stack.current_element_is open_elements ["html"] then - report l (`Unexpected_eoi "frameset") !throw mode' - else mode' ()) - (fun () -> emit_end l) - - | l, _ -> - report l (`Bad_content "frameset") !throw in_frameset_mode - end - + | l, `String s when is_whitespace_only s -> + add_string l s; + in_frameset_mode () + | l, `Comment s -> emit l (`Comment s) in_frameset_mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + in_frameset_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "frameset" in_frameset_mode v + | l, `Start ({ name = "frameset" } as t) -> + push_and_emit l t in_frameset_mode + | l, `End { name = "frameset" } -> + (fun mode' -> + if Stack.current_element_is open_elements [ "html" ] then + report l (`Unmatched_end_tag "frameset") !throw mode' + else pop l mode') (fun () -> + if Stack.current_element_is open_elements [ "frameset" ] then + in_frameset_mode () + else after_frameset_mode ()) + | l, `Start ({ name = "frame" } as t) -> + push_and_emit ~acknowledge:true l t (fun () -> + pop l in_frameset_mode) + | (_, `Start { name = "noframes" }) as v -> + in_head_mode_rules in_frameset_mode v + | l, `EOF -> + (fun mode' -> + if not @@ Stack.current_element_is open_elements [ "html" ] then + report l (`Unexpected_eoi "frameset") !throw mode' + else mode' ()) (fun () -> emit_end l) + | l, _ -> report l (`Bad_content "frameset") !throw in_frameset_mode + end (* 8.2.5.4.21. *) and after_frameset_mode () = dispatch tokens begin function - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - add_character l c; - after_frameset_mode () - - | l, `String s when is_whitespace_only s -> - add_string l s; - after_frameset_mode () - - | l, `Comment s -> - emit l (`Comment s) after_frameset_mode - - | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw - after_frameset_mode - - | _, `Start {name = "html"} as v -> - in_body_mode_rules "html" after_frameset_mode v - - | l, `End {name = "html"} -> - close_element l "html" after_after_frameset_mode - - | _, `Start {name = "noframes"} as v -> - in_head_mode_rules after_frameset_mode v - - | l, `EOF -> - emit_end l - - | l, _ -> - report l (`Bad_content "html") !throw after_frameset_mode - end - + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + add_character l c; + after_frameset_mode () + | l, `String s when is_whitespace_only s -> + add_string l s; + after_frameset_mode () + | l, `Comment s -> emit l (`Comment s) after_frameset_mode + | l, `Doctype _ -> + report l (`Bad_document "doctype should be first") !throw + after_frameset_mode + | (_, `Start { name = "html" }) as v -> + in_body_mode_rules "html" after_frameset_mode v + | l, `End { name = "html" } -> + close_element l "html" after_after_frameset_mode + | (_, `Start { name = "noframes" }) as v -> + in_head_mode_rules after_frameset_mode v + | l, `EOF -> emit_end l + | l, _ -> report l (`Bad_content "html") !throw after_frameset_mode + end (* 8.2.5.4.22. *) and after_after_body_mode () = dispatch tokens begin function - | l, `Comment s -> - emit l (`Comment s) after_after_body_mode - - | _, `Doctype _ - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) - | _, `Start {name = "html"} as v -> - in_body_mode_rules "html" after_after_body_mode v - - | _, `String s as v when is_whitespace_only s -> - in_body_mode_rules "html" after_after_body_mode v - - | l, `EOF -> - emit_end l - - | l, _ as v -> - push tokens v; - report l (`Bad_content "html") !throw in_body_mode - end - + | l, `Comment s -> emit l (`Comment s) after_after_body_mode + | ( _, `Doctype _ + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) + | _, `Start { name = "html" } ) as v -> + in_body_mode_rules "html" after_after_body_mode v + | (_, `String s) as v when is_whitespace_only s -> + in_body_mode_rules "html" after_after_body_mode v + | l, `EOF -> emit_end l + | (l, _) as v -> + push tokens v; + report l (`Bad_content "html") !throw in_body_mode + end (* 8.2.5.4.23. *) and after_after_frameset_mode () = dispatch tokens begin function - | l, `Comment s -> - emit l (`Comment s) after_after_frameset_mode - - | _, `Doctype _ - | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) - | _, `Start {name = "html"} as v -> - in_body_mode_rules "html" after_after_frameset_mode v - - | _, `String s as v when is_whitespace_only s -> - in_body_mode_rules "html" after_after_frameset_mode v - - | l, `EOF -> - emit_end l - - | _, `Start {name = "noframes"} as v -> - in_head_mode_rules after_after_frameset_mode v - - | l, _ -> - report l (`Bad_content "html") !throw after_after_frameset_mode - end - + | l, `Comment s -> emit l (`Comment s) after_after_frameset_mode + | ( _, `Doctype _ + | _, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) + | _, `Start { name = "html" } ) as v -> + in_body_mode_rules "html" after_after_frameset_mode v + | (_, `String s) as v when is_whitespace_only s -> + in_body_mode_rules "html" after_after_frameset_mode v + | l, `EOF -> emit_end l + | (_, `Start { name = "noframes" }) as v -> + in_head_mode_rules after_after_frameset_mode v + | l, _ -> + report l (`Bad_content "html") !throw after_after_frameset_mode + end (* 8.2.5.5. *) and foreign_start_tag mode l tag = let namespace = match Stack.adjusted_current_element context open_elements with | None -> `HTML - | Some {element_name = ns, _} -> ns + | Some { element_name = ns, _ } -> ns in push_and_emit ~acknowledge:true ~namespace l tag (fun () -> - if tag.self_closing then pop l mode - else mode ()) - + if tag.self_closing then pop l mode else mode ()) and is_html_font_tag tag = - tag.Token_tag.attributes |> List.exists (function + tag.Token_tag.attributes + |> List.exists (function | ("color" | "face" | "size"), _ -> true | _ -> false) - and foreign_content mode force_html v = match v with | l, `Char 0 -> - report l (`Bad_token ("U+0000", "foreign content", "null")) !throw - (fun () -> - add_character l u_rep; - mode ()) - + report l + (`Bad_token ("U+0000", "foreign content", "null")) + !throw + (fun () -> + add_character l u_rep; + mode ()) | l, `String s -> - add_string l s; - if not @@ is_whitespace_only s then frameset_ok := false; - mode () - - | l, `Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020 as c) -> - add_character l c; - mode () - + add_string l s; + if not @@ is_whitespace_only s then frameset_ok := false; + mode () + | l, `Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> + add_character l c; + mode () | l, `Char c -> - frameset_ok := false; - add_character l c; - mode () - - | l, `Comment s -> - emit l (`Comment s) mode - + frameset_ok := false; + add_character l c; + mode () + | l, `Comment s -> emit l (`Comment s) mode | l, `Doctype _ -> - report l (`Bad_document "doctype should be first") !throw mode - - | l, `Start ({name = - "b" | "big" | "blockquote" | "body" | "br" | "center" | "code" | - "dd" | "div" | "dl" | "dt" | "em" | "embed" | "font" | "h1" | "h2" | - "h3" | "h4" | "h5" | "h6" | "head" | "hr" | "i" | "img" | "li" | - "listing" | "main" | "meta" | "nobr" | "ol" | "p" | "pre" | "ruby" | - "s" | "small" | "span" | "strong" | "strike" | "sub" | "sup" | - "table" | "tt" | "u" | "ul" | "var" as name} as t) as v -> - if name = "font" && not @@ is_html_font_tag t then - foreign_start_tag mode l t - else - misnested_tag l t "xml tag" (fun () -> - push tokens v; - pop l (fun () -> - pop_until (function - | {element_name = `HTML, _} -> true - | {is_html_integration_point = true} -> true - | {element_name} -> - Foreign.is_mathml_text_integration_point element_name) - l mode)) - - | l, `Start t -> - foreign_start_tag mode l t - - | l, `End {name = "script"} - when + report l (`Bad_document "doctype should be first") !throw mode + | ( l, + `Start + ({ + name = + ( "b" | "big" | "blockquote" | "body" | "br" | "center" | "code" + | "dd" | "div" | "dl" | "dt" | "em" | "embed" | "font" | "h1" + | "h2" | "h3" | "h4" | "h5" | "h6" | "head" | "hr" | "i" | "img" + | "li" | "listing" | "main" | "meta" | "nobr" | "ol" | "p" + | "pre" | "ruby" | "s" | "small" | "span" | "strong" | "strike" + | "sub" | "sup" | "table" | "tt" | "u" | "ul" | "var" ) as name; + } as t) ) as v -> + if name = "font" && (not @@ is_html_font_tag t) then + foreign_start_tag mode l t + else + misnested_tag l t "xml tag" (fun () -> + push tokens v; + pop l (fun () -> + pop_until + (function + | { element_name = `HTML, _ } -> true + | { is_html_integration_point = true } -> true + | { element_name } -> + Foreign.is_mathml_text_integration_point element_name) + l mode)) + | l, `Start t -> foreign_start_tag mode l t + | l, `End { name = "script" } + when match Stack.current_element open_elements with + | Some { element_name = `SVG, "script" } -> true + | _ -> false -> + pop l mode + | l, `End { name } -> + (fun mode' -> match Stack.current_element open_elements with - | Some {element_name = `SVG, "script"} -> true - | _ -> false -> - pop l mode - - | l, `End {name} -> - (fun mode' -> - match Stack.current_element open_elements with - | Some {element_name = _, name'} when String.lowercase_ascii name' = name -> - mode' () - | _ -> - report l (`Unmatched_end_tag name) !throw (fun () -> - mode' ())) - (fun () -> - let rec scan = function - | [] -> mode () - | {element_name = ns, name'}::_ - when String.lowercase_ascii name' = name -> - close_element ~ns l name mode - | {element_name = `HTML, _}::_ -> force_html () - | _::rest -> scan rest - in - scan !(Stack.elements open_elements)) - + | Some { element_name = _, name' } + when String.lowercase_ascii name' = name -> + mode' () + | _ -> report l (`Unmatched_end_tag name) !throw (fun () -> mode' ())) + (fun () -> + let rec scan = function + | [] -> mode () + | { element_name = ns, name' } :: _ + when String.lowercase_ascii name' = name -> + close_element ~ns l name mode + | { element_name = `HTML, _ } :: _ -> force_html () + | _ :: rest -> scan rest + in + scan !(Stack.elements open_elements)) | _, `EOF -> force_html () - in construct constructor diff --git a/src/lite/html_parser.mli b/src/lite/html_parser.mli index bfc022b..087012a 100644 --- a/src/lite/html_parser.mli +++ b/src/lite/html_parser.mli @@ -8,4 +8,4 @@ val parse : [< `Document | `Fragment of string ] -> Error.parse_handler -> Token_source.t -> - (location * signal) Kstream.t + (location * signal) Kstream.t diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index 650fa75..79fd5c1 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -4,14 +4,15 @@ type async = Markup_common.async type sync = Markup_common.sync type ('data, 'sync) stream = ('data, 'sync) Markup_common.stream - type location = Markup_common.location type name = Markup_common.name + type xml_declaration = Markup_common.xml_declaration = { version : string; encoding : string option; standalone : bool option; } + type doctype = Markup_common.doctype = { doctype_name : string option; public_identifier : string option; @@ -19,6 +20,7 @@ type doctype = Markup_common.doctype = { raw_text : string option; force_quirks : bool; } + type signal = Markup_common.signal module Error = Markup_common.Error @@ -40,9 +42,10 @@ let parse_html ?(report = fun _ _ -> ()) |> fun stream -> (stream : (signal, sync) stream) let iter f stream = - stream - |> Markup_common.Stream.Private.of_stream - |> Kstream.iter (fun value _ continue -> f value; continue ()) + stream |> Markup_common.Stream.Private.of_stream + |> Kstream.iter (fun value _ continue -> + f value; + continue ()) |> fun iterate -> iterate raise ignore let write_html ?escape_attribute ?escape_text buffer signals = diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index f983ae6..8131d73 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -6,14 +6,15 @@ type async = Markup_common.async type sync = Markup_common.sync type ('data, 'sync) stream = ('data, 'sync) Markup_common.stream - type location = Markup_common.location type name = Markup_common.name + type xml_declaration = Markup_common.xml_declaration = { version : string; encoding : string option; standalone : bool option; } + type doctype = Markup_common.doctype = { doctype_name : string option; public_identifier : string option; @@ -21,6 +22,7 @@ type doctype = Markup_common.doctype = { raw_text : string option; force_quirks : bool; } + type signal = Markup_common.signal module Error = Markup_common.Error @@ -31,7 +33,8 @@ val signal_to_string : [< signal ] -> string val parse_html : ?report:(location -> Error.t -> unit) -> ?context:[ `Document | `Fragment of string ] -> - string -> (signal, sync) stream + string -> + (signal, sync) stream val iter : ('a -> unit) -> ('a, sync) stream -> unit diff --git a/src/lite/namespace.ml b/src/lite/namespace.ml index 5286757..404fad0 100644 --- a/src/lite/namespace.ml +++ b/src/lite/namespace.ml @@ -4,35 +4,27 @@ open Common let list_map_cps : ('a -> 'b cps) -> 'a list -> 'b list cps = - fun f l throw k -> - + fun f l throw k -> let rec loop accumulator = function | [] -> k (List.rev accumulator) - | x::l -> f x throw (fun x' -> loop (x'::accumulator) l) + | x :: l -> f x throw (fun x' -> loop (x' :: accumulator) l) in loop [] l -module Parsing = -struct - type context_entry = - {f : string -> string option; - previous : context_entry} - +module Parsing = struct + type context_entry = { f : string -> string option; previous : context_entry } type context = context_entry ref let parse qualified_name = try let colon_index = String.index qualified_name ':' in - if colon_index = 0 then - raise Not_found; + if colon_index = 0 then raise Not_found; let prefix = String.sub qualified_name 0 colon_index in let suffix = - String.sub qualified_name - (colon_index + 1) + String.sub qualified_name (colon_index + 1) (String.length qualified_name - colon_index - 1) in - prefix, suffix - + (prefix, suffix) with Not_found -> ("", qualified_name) let init top_level = @@ -41,84 +33,88 @@ struct | "xmlns" -> Some xmlns_ns | s -> top_level s in - let rec entry = {f; previous = entry} in + let rec entry = { f; previous = entry } in ref entry let expand_element report context raw_element_name throw k = let ns, name = parse raw_element_name in match !context.f ns with | Some uri -> k (uri, name) - | None -> - match ns with - | "" -> k ("", name) - | prefix -> - report () (`Bad_namespace prefix) throw (fun () -> k (prefix, name)) + | None -> ( + match ns with + | "" -> k ("", name) + | prefix -> + report () (`Bad_namespace prefix) throw (fun () -> k (prefix, name)) + ) let push report context raw_element_name raw_attributes throw k = let parsed_attributes = - raw_attributes |> List.map (fun (name, value) -> parse name, value) in + raw_attributes |> List.map (fun (name, value) -> (parse name, value)) + in let f = - parsed_attributes |> List.fold_left (fun f -> function - | ("xmlns", prefix), uri -> - (fun p -> if p = prefix then Some uri else f p) - | ("", "xmlns"), uri -> - (fun p -> if p = "" then Some uri else f p) - | _ -> f) - !context.f + parsed_attributes + |> List.fold_left + (fun f -> function + | ("xmlns", prefix), uri -> + fun p -> if p = prefix then Some uri else f p + | ("", "xmlns"), uri -> fun p -> if p = "" then Some uri else f p + | _ -> f) + !context.f in - let entry = {f; previous = !context} in + let entry = { f; previous = !context } in context := entry; expand_element report context raw_element_name throw (fun expanded_element_name -> - list_map_cps begin fun (name, value) _ k -> - match name with - | "", "xmlns" -> k ((xmlns_ns, "xmlns"), value) - | "", name -> k (("", name), value) - | ns, name -> - match f ns with - | Some uri -> k ((uri, name), value) - | None -> - report () (`Bad_namespace ns) throw (fun () -> k ((ns, name), value)) - end parsed_attributes throw (fun expanded_attributes -> - k (expanded_element_name, expanded_attributes))) - - let pop ({contents = {previous}} as context) = - context := previous + list_map_cps + begin fun (name, value) _ k -> + match name with + | "", "xmlns" -> k ((xmlns_ns, "xmlns"), value) + | "", name -> k (("", name), value) + | ns, name -> ( + match f ns with + | Some uri -> k ((uri, name), value) + | None -> + report () (`Bad_namespace ns) throw (fun () -> + k ((ns, name), value))) + end + parsed_attributes throw + (fun expanded_attributes -> + k (expanded_element_name, expanded_attributes))) + + let pop ({ contents = { previous } } as context) = context := previous end module StringMap = Map.Make (String) -module Writing = -struct - type context_entry = - {namespace_to_prefix : string list StringMap.t; - prefix_to_namespace : string StringMap.t; - previous : context_entry} +module Writing = struct + type context_entry = { + namespace_to_prefix : string list StringMap.t; + prefix_to_namespace : string StringMap.t; + previous : context_entry; + } type context = context_entry ref * (string -> string option) let init top_level = let namespace_to_prefix = - StringMap.empty - |> StringMap.add "" [""] - |> StringMap.add xml_ns ["xml"] - |> StringMap.add xmlns_ns ["xmlns"] + StringMap.empty |> StringMap.add "" [ "" ] + |> StringMap.add xml_ns [ "xml" ] + |> StringMap.add xmlns_ns [ "xmlns" ] in let prefix_to_namespace = - StringMap.empty - |> StringMap.add "" "" - |> StringMap.add "xml" xml_ns + StringMap.empty |> StringMap.add "" "" |> StringMap.add "xml" xml_ns |> StringMap.add "xmlns" xmlns_ns in let rec entry = - {namespace_to_prefix; prefix_to_namespace; previous = entry} in + { namespace_to_prefix; prefix_to_namespace; previous = entry } + in - ref entry, top_level + (ref entry, top_level) let lookup report allow_default context namespace throw k = let candidate_prefixes = @@ -128,27 +124,30 @@ struct let prefix = try - Some (candidate_prefixes |> List.find (fun prefix -> - (allow_default || prefix <> "") && - begin - try StringMap.find prefix !(fst context).prefix_to_namespace = - namespace - with Not_found -> false - end)) + Some + (candidate_prefixes + |> List.find (fun prefix -> + (allow_default || prefix <> "") + && begin try + StringMap.find prefix !(fst context).prefix_to_namespace + = namespace + with Not_found -> false + end)) with Not_found -> None in let prefix = match prefix with | Some _ -> prefix - | None -> - match snd context namespace with - | None -> None - | Some prefix -> - if not allow_default && prefix = "" || - StringMap.mem prefix !(fst context).prefix_to_namespace then - None - else Some prefix + | None -> ( + match snd context namespace with + | None -> None + | Some prefix -> + if + ((not allow_default) && prefix = "") + || StringMap.mem prefix !(fst context).prefix_to_namespace + then None + else Some prefix) in match prefix with @@ -156,52 +155,49 @@ struct | Some prefix -> k prefix let format prefix name = - match prefix with - | "" -> name - | prefix -> prefix ^ ":" ^ name + match prefix with "" -> name | prefix -> prefix ^ ":" ^ name let unexpand_element report context (namespace, name) throw k = lookup report true context namespace throw (fun prefix -> - k (format prefix name)) + k (format prefix name)) let unexpand_attribute report context ((namespace, name), value) throw k = match namespace with | "" -> k (name, value) | uri -> - if uri = xmlns_ns && name = "xmlns" then k ("xmlns", value) - else - lookup report false context namespace throw (fun prefix -> - k (format prefix name, value)) + if uri = xmlns_ns && name = "xmlns" then k ("xmlns", value) + else + lookup report false context namespace throw (fun prefix -> + k (format prefix name, value)) let extend k v map = - let vs = - try StringMap.find k map - with Not_found -> [] - in - StringMap.add k (v::vs) map + let vs = try StringMap.find k map with Not_found -> [] in + StringMap.add k (v :: vs) map let push report context element_name attributes throw k = let namespace_to_prefix, prefix_to_namespace = - attributes |> List.fold_left (fun (ns_to_prefix, prefix_to_ns) -> function - | (ns, "xmlns"), uri when ns = xmlns_ns -> - extend uri "" ns_to_prefix, - StringMap.add "" uri prefix_to_ns - | (ns, prefix), uri when ns = xmlns_ns -> - extend uri prefix ns_to_prefix, - StringMap.add prefix uri prefix_to_ns - | _ -> ns_to_prefix, prefix_to_ns) - (!(fst context).namespace_to_prefix, !(fst context).prefix_to_namespace) + attributes + |> List.fold_left + (fun (ns_to_prefix, prefix_to_ns) -> function + | (ns, "xmlns"), uri when ns = xmlns_ns -> + (extend uri "" ns_to_prefix, StringMap.add "" uri prefix_to_ns) + | (ns, prefix), uri when ns = xmlns_ns -> + ( extend uri prefix ns_to_prefix, + StringMap.add prefix uri prefix_to_ns ) + | _ -> (ns_to_prefix, prefix_to_ns)) + ( !(fst context).namespace_to_prefix, + !(fst context).prefix_to_namespace ) in let entry = - {namespace_to_prefix; prefix_to_namespace; previous = !(fst context)} in - (fst context) := entry; + { namespace_to_prefix; prefix_to_namespace; previous = !(fst context) } + in + fst context := entry; unexpand_element report context element_name throw (fun element_name -> - list_map_cps (unexpand_attribute report context) attributes throw - (fun attributes -> - k (element_name, attributes))) + list_map_cps (unexpand_attribute report context) attributes throw + (fun attributes -> k (element_name, attributes))) - let pop ({contents = {previous}}, _ as context) = - (fst context) := previous + let pop (({ contents = { previous } }, _) as context) = + fst context := previous end diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index bf2cc44..d5e2155 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -6,838 +6,2659 @@ The original source is available from https://github.com/ygrek/ocaml-webstack. * open Common -type location_out = { - mutable line : int; - mutable column : int; -} +type location_out = { mutable line : int; mutable column : int } type t = { - data : string; - cs : int ref; - p : int ref; - pe : int ref; - eof : int ref; - mark : int ref; - mark_end : int ref; - tag : string ref; - key : string ref; - attrs : (string * string) list ref; - directive : string ref; - mutable line : int; - tokens : Html_tokenizer.token array; - lines : int array; - mutable read : int; - mutable write : int; - mutable finished : bool; + data : string; + cs : int ref; + p : int ref; + pe : int ref; + eof : int ref; + mark : int ref; + mark_end : int ref; + tag : string ref; + key : string ref; + attrs : (string * string) list ref; + directive : string ref; + mutable line : int; + tokens : Html_tokenizer.token array; + lines : int array; + mutable read : int; + mutable write : int; + mutable finished : bool; } -let decode text = -try Html_entity_decoder.decode text with _ -> text +let decode text = try Html_entity_decoder.decode text with _ -> text let attributes attrs = -List.map (fun (name, value) -> name, decode value) attrs + List.map (fun (name, value) -> (name, decode value)) attrs let make_tag name attributes = -{Token_tag.name; attributes; self_closing = false} + { Token_tag.name; attributes; self_closing = false } let buffer_capacity = 128 let maximum_transition_output = 3 let emit scanner token = -scanner.tokens.(scanner.write) <- token; -scanner.lines.(scanner.write) <- scanner.line; -scanner.write <- scanner.write + 1 - -let emit_many scanner tokens = -List.iter (emit scanner) tokens + scanner.tokens.(scanner.write) <- token; + scanner.lines.(scanner.write) <- scanner.line; + scanner.write <- scanner.write + 1 + +let emit_many scanner tokens = List.iter (emit scanner) tokens + +let _htmlstream_trans_keys : int array = + [| + 1; + 10; + 1; + 10; + 0; + 22; + 1; + 1; + 1; + 22; + 1; + 6; + 1; + 6; + 1; + 6; + 1; + 12; + 1; + 22; + 0; + 22; + 0; + 22; + 0; + 22; + 0; + 22; + 0; + 12; + 0; + 12; + 1; + 10; + 1; + 3; + 1; + 3; + 0; + 22; + 1; + 12; + 1; + 5; + 1; + 5; + 0; + 22; + 0; + 22; + 0; + 22; + 0; + 22; + 0; + 12; + 1; + 10; + 0; + 12; + 0; + 12; + 1; + 10; + 1; + 3; + 1; + 3; + 0; + 22; + 1; + 5; + 1; + 5; + 0; + 22; + 1; + 12; + 1; + 22; + 1; + 22; + 1; + 10; + 1; + 10; + 0; + 10; + 0; + 20; + 1; + 14; + 1; + 19; + 1; + 16; + 1; + 18; + 1; + 21; + 0; + 12; + 1; + 1; + 1; + 10; + 1; + 10; + 0; + 10; + 0; + 20; + 1; + 21; + 1; + 22; + 1; + 17; + 1; + 15; + 0; + 12; + 1; + 1; + 1; + 10; + 1; + 10; + 0; + 10; + 0; + 21; + 1; + 16; + 1; + 21; + 1; + 17; + 1; + 15; + 0; + 12; + 1; + 1; + 1; + 12; + 1; + 1; + 0; + |] + +let _htmlstream_char_class : int array = + [| + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 1; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 2; + 3; + 4; + 4; + 4; + 4; + 5; + 4; + 4; + 4; + 4; + 4; + 6; + 7; + 8; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 7; + 4; + 10; + 11; + 12; + 13; + 4; + 9; + 9; + 14; + 9; + 15; + 9; + 9; + 9; + 16; + 9; + 9; + 17; + 9; + 9; + 9; + 18; + 9; + 19; + 20; + 21; + 9; + 9; + 9; + 9; + 22; + 9; + 4; + 4; + 4; + 4; + 7; + 4; + 9; + 9; + 14; + 9; + 15; + 9; + 9; + 9; + 16; + 9; + 9; + 17; + 9; + 9; + 9; + 18; + 9; + 19; + 20; + 21; + 9; + 9; + 9; + 9; + 22; + 9; + 0; + |] + +let _htmlstream_index_offsets : int array = + [| + 0; + 10; + 20; + 43; + 44; + 66; + 72; + 78; + 84; + 96; + 118; + 141; + 164; + 187; + 210; + 223; + 236; + 246; + 249; + 252; + 275; + 287; + 292; + 297; + 320; + 343; + 366; + 389; + 402; + 412; + 425; + 438; + 448; + 451; + 454; + 477; + 482; + 487; + 510; + 522; + 544; + 566; + 576; + 586; + 597; + 618; + 632; + 651; + 667; + 685; + 706; + 719; + 720; + 730; + 740; + 751; + 772; + 793; + 815; + 832; + 847; + 860; + 861; + 871; + 881; + 892; + 914; + 930; + 951; + 968; + 983; + 996; + 997; + 1009; + 0; + |] + +let _htmlstream_indices : int array = + [| + 2; + 1; + 1; + 1; + 1; + 1; + 1; + 1; + 1; + 3; + 6; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 7; + 3; + 10; + 11; + 9; + 9; + 9; + 12; + 12; + 13; + 12; + 9; + 9; + 9; + 14; + 12; + 12; + 12; + 12; + 12; + 12; + 12; + 12; + 12; + 16; + 18; + 9; + 9; + 9; + 9; + 19; + 9; + 9; + 20; + 9; + 9; + 9; + 9; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 18; + 9; + 9; + 9; + 9; + 22; + 24; + 22; + 22; + 22; + 22; + 25; + 24; + 22; + 22; + 22; + 22; + 27; + 24; + 22; + 22; + 22; + 22; + 27; + 22; + 22; + 22; + 22; + 22; + 0; + 18; + 9; + 9; + 9; + 9; + 30; + 30; + 9; + 30; + 9; + 9; + 9; + 9; + 30; + 30; + 30; + 30; + 30; + 30; + 30; + 30; + 30; + 32; + 33; + 9; + 9; + 9; + 9; + 30; + 30; + 9; + 30; + 9; + 9; + 34; + 35; + 30; + 30; + 30; + 30; + 30; + 30; + 30; + 30; + 30; + 37; + 38; + 9; + 9; + 9; + 9; + 39; + 39; + 9; + 39; + 9; + 9; + 40; + 41; + 39; + 39; + 39; + 39; + 39; + 39; + 39; + 39; + 39; + 43; + 44; + 9; + 9; + 9; + 9; + 45; + 45; + 9; + 45; + 9; + 46; + 47; + 48; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 50; + 51; + 9; + 9; + 9; + 9; + 52; + 52; + 9; + 52; + 9; + 53; + 54; + 55; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 53; + 58; + 57; + 59; + 57; + 60; + 57; + 57; + 57; + 57; + 57; + 57; + 9; + 63; + 64; + 62; + 9; + 62; + 9; + 62; + 62; + 62; + 62; + 62; + 62; + 65; + 68; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 69; + 72; + 71; + 73; + 76; + 75; + 77; + 79; + 80; + 9; + 9; + 9; + 9; + 52; + 52; + 9; + 52; + 9; + 9; + 54; + 55; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 18; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 40; + 84; + 83; + 83; + 83; + 73; + 87; + 86; + 86; + 86; + 77; + 89; + 90; + 9; + 9; + 9; + 9; + 91; + 91; + 92; + 91; + 9; + 9; + 93; + 9; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 95; + 96; + 9; + 9; + 9; + 9; + 97; + 97; + 98; + 97; + 9; + 9; + 99; + 9; + 97; + 97; + 97; + 97; + 97; + 97; + 97; + 97; + 97; + 101; + 102; + 9; + 9; + 9; + 9; + 103; + 103; + 104; + 103; + 9; + 105; + 106; + 9; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 108; + 109; + 9; + 9; + 9; + 9; + 110; + 110; + 111; + 110; + 9; + 112; + 113; + 9; + 110; + 110; + 110; + 110; + 110; + 110; + 110; + 110; + 110; + 98; + 115; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 116; + 119; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 120; + 112; + 123; + 122; + 124; + 122; + 125; + 122; + 122; + 122; + 122; + 122; + 122; + 9; + 128; + 129; + 127; + 9; + 127; + 9; + 127; + 127; + 127; + 127; + 127; + 127; + 130; + 133; + 132; + 132; + 132; + 132; + 132; + 132; + 132; + 132; + 134; + 137; + 136; + 138; + 141; + 140; + 142; + 144; + 145; + 9; + 9; + 9; + 9; + 110; + 110; + 111; + 110; + 9; + 9; + 113; + 9; + 110; + 110; + 110; + 110; + 110; + 110; + 110; + 110; + 110; + 148; + 147; + 147; + 147; + 138; + 151; + 150; + 150; + 150; + 142; + 154; + 155; + 153; + 153; + 153; + 153; + 156; + 156; + 153; + 156; + 153; + 153; + 157; + 153; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 160; + 159; + 159; + 159; + 159; + 159; + 159; + 159; + 159; + 159; + 159; + 0; + 163; + 162; + 162; + 162; + 162; + 164; + 164; + 162; + 164; + 162; + 162; + 165; + 162; + 164; + 164; + 164; + 164; + 164; + 164; + 164; + 164; + 164; + 18; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 20; + 9; + 9; + 9; + 9; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 169; + 168; + 168; + 168; + 168; + 168; + 168; + 168; + 168; + 170; + 172; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 174; + 175; + 171; + 171; + 171; + 171; + 171; + 171; + 176; + 171; + 173; + 176; + 177; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 178; + 172; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 171; + 171; + 179; + 172; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 180; + 172; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 171; + 171; + 171; + 171; + 181; + 172; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 182; + 172; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 183; + 183; + 184; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 173; + 171; + 185; + 187; + 190; + 189; + 189; + 189; + 189; + 189; + 189; + 189; + 189; + 191; + 193; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 195; + 196; + 192; + 192; + 192; + 192; + 192; + 192; + 197; + 192; + 194; + 197; + 198; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 199; + 193; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 200; + 193; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 201; + 193; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 192; + 192; + 192; + 192; + 192; + 192; + 202; + 193; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 192; + 192; + 192; + 192; + 203; + 203; + 204; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 194; + 192; + 205; + 207; + 210; + 209; + 209; + 209; + 209; + 209; + 209; + 209; + 209; + 211; + 213; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 215; + 216; + 212; + 212; + 212; + 212; + 212; + 212; + 217; + 212; + 214; + 217; + 218; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 219; + 213; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 212; + 212; + 212; + 212; + 212; + 220; + 213; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 221; + 213; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 212; + 212; + 212; + 212; + 212; + 212; + 222; + 213; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 212; + 212; + 212; + 212; + 223; + 223; + 224; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 214; + 212; + 225; + 227; + 229; + 228; + 228; + 228; + 228; + 228; + 228; + 228; + 228; + 228; + 228; + 230; + 232; + 0; + |] + +let _htmlstream_index_defaults : int array = + [| + 1; + 5; + 9; + 15; + 9; + 9; + 22; + 22; + 22; + 9; + 9; + 9; + 9; + 9; + 57; + 62; + 67; + 71; + 75; + 9; + 9; + 83; + 86; + 9; + 9; + 9; + 9; + 9; + 118; + 122; + 127; + 132; + 136; + 140; + 9; + 147; + 150; + 153; + 159; + 162; + 9; + 168; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 171; + 186; + 189; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 192; + 206; + 209; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 212; + 226; + 228; + 231; + 0; + |] + +let _htmlstream_cond_targs : int array = + [| + 0; + 1; + 1; + 2; + 1; + 1; + 1; + 2; + 2; + 3; + 2; + 4; + 23; + 37; + 40; + 3; + 3; + 4; + 3; + 5; + 9; + 5; + 6; + 6; + 6; + 7; + 7; + 8; + 8; + 9; + 10; + 10; + 11; + 11; + 16; + 20; + 11; + 11; + 11; + 12; + 16; + 20; + 12; + 13; + 13; + 12; + 14; + 16; + 20; + 13; + 13; + 13; + 12; + 14; + 16; + 20; + 14; + 15; + 14; + 17; + 21; + 15; + 15; + 11; + 11; + 16; + 16; + 1; + 1; + 2; + 17; + 18; + 18; + 19; + 18; + 18; + 18; + 19; + 19; + 11; + 11; + 20; + 21; + 22; + 22; + 22; + 22; + 22; + 23; + 24; + 24; + 23; + 27; + 31; + 24; + 24; + 24; + 25; + 27; + 31; + 25; + 26; + 26; + 25; + 27; + 29; + 31; + 26; + 26; + 26; + 25; + 27; + 29; + 31; + 27; + 27; + 28; + 28; + 1; + 1; + 2; + 29; + 30; + 29; + 32; + 35; + 30; + 30; + 24; + 24; + 31; + 31; + 1; + 1; + 2; + 32; + 33; + 33; + 34; + 33; + 33; + 33; + 34; + 34; + 24; + 24; + 35; + 36; + 36; + 36; + 36; + 36; + 37; + 38; + 37; + 37; + 39; + 0; + 38; + 38; + 38; + 39; + 38; + 38; + 39; + 0; + 40; + 41; + 42; + 42; + 43; + 42; + 42; + 43; + 43; + 43; + 44; + 44; + 45; + 46; + 47; + 48; + 49; + 50; + 50; + 51; + 51; + 51; + 52; + 53; + 53; + 54; + 53; + 53; + 54; + 54; + 54; + 55; + 55; + 56; + 57; + 58; + 59; + 60; + 60; + 61; + 61; + 61; + 62; + 63; + 63; + 64; + 63; + 63; + 64; + 64; + 64; + 65; + 65; + 66; + 67; + 68; + 69; + 70; + 70; + 71; + 71; + 71; + 72; + 72; + 73; + 73; + 73; + 0; + |] + +let _htmlstream_cond_actions : int array = + [| + 0; + 1; + 2; + 0; + 3; + 0; + 4; + 3; + 5; + 5; + 4; + 6; + 7; + 6; + 6; + 0; + 4; + 5; + 8; + 0; + 1; + 5; + 0; + 5; + 4; + 0; + 5; + 0; + 5; + 5; + 0; + 5; + 9; + 10; + 9; + 9; + 5; + 0; + 4; + 1; + 0; + 0; + 5; + 11; + 12; + 0; + 11; + 13; + 13; + 5; + 0; + 4; + 14; + 0; + 15; + 15; + 5; + 1; + 4; + 0; + 0; + 5; + 0; + 16; + 17; + 16; + 18; + 19; + 20; + 18; + 5; + 1; + 2; + 21; + 5; + 0; + 4; + 22; + 5; + 15; + 23; + 5; + 5; + 1; + 2; + 5; + 0; + 4; + 5; + 24; + 25; + 0; + 24; + 24; + 5; + 0; + 4; + 1; + 0; + 0; + 5; + 11; + 12; + 0; + 13; + 11; + 13; + 5; + 0; + 4; + 14; + 15; + 0; + 15; + 5; + 4; + 0; + 26; + 27; + 28; + 26; + 5; + 1; + 4; + 0; + 0; + 5; + 0; + 16; + 17; + 16; + 29; + 30; + 31; + 29; + 5; + 1; + 2; + 21; + 5; + 0; + 4; + 22; + 5; + 15; + 23; + 5; + 1; + 2; + 5; + 0; + 4; + 5; + 32; + 0; + 4; + 1; + 32; + 5; + 0; + 4; + 5; + 33; + 34; + 0; + 33; + 5; + 0; + 1; + 35; + 21; + 0; + 4; + 22; + 0; + 4; + 0; + 4; + 0; + 0; + 0; + 0; + 0; + 0; + 4; + 36; + 0; + 4; + 0; + 1; + 35; + 21; + 0; + 4; + 22; + 0; + 4; + 0; + 4; + 0; + 0; + 0; + 0; + 0; + 4; + 37; + 0; + 4; + 0; + 1; + 35; + 21; + 0; + 4; + 22; + 0; + 4; + 0; + 4; + 0; + 0; + 0; + 0; + 0; + 4; + 38; + 0; + 4; + 0; + 4; + 39; + 0; + 4; + 0; + |] + +let _htmlstream_eof_trans : int array = + [| + 1; + 5; + 9; + 16; + 18; + 22; + 24; + 27; + 29; + 30; + 32; + 37; + 43; + 50; + 57; + 62; + 67; + 71; + 75; + 79; + 82; + 83; + 86; + 89; + 95; + 101; + 108; + 115; + 118; + 122; + 127; + 132; + 136; + 140; + 144; + 147; + 150; + 153; + 159; + 162; + 167; + 168; + 172; + 175; + 177; + 179; + 180; + 181; + 182; + 183; + 184; + 187; + 189; + 193; + 196; + 198; + 200; + 201; + 202; + 203; + 204; + 207; + 209; + 213; + 216; + 218; + 220; + 221; + 222; + 223; + 224; + 227; + 229; + 232; + 0; + |] + +let htmlstream_start : int = 0 +let htmlstream_first_final : int = 0 +let htmlstream_error : int = -1 +let htmlstream_en_in_script : int = 41 +let htmlstream_en_in_style : int = 52 +let htmlstream_en_in_title : int = 62 +let htmlstream_en_garbage_tag : int = 72 +let htmlstream_en_main : int = 0 -let _htmlstream_trans_keys : int array = [| -1; 10; 1; 10; 0; 22; 1; 1; 1; 22; 1; 6; 1; 6; 1; 6; 1; 12; 1; 22; 0; 22; 0; 22; 0; 22; 0; 22; 0; 12; 0; 12; 1; 10; 1; 3; 1; 3; 0; 22; 1; 12; 1; 5; 1; 5; 0; 22; 0; 22; 0; 22; 0; 22; 0; 12; 1; 10; 0; 12; 0; 12; 1; 10; 1; 3; 1; 3; 0; 22; 1; 5; 1; 5; 0; 22; 1; 12; 1; 22; 1; 22; 1; 10; 1; 10; 0; 10; 0; 20; 1; 14; 1; 19; 1; 16; 1; 18; 1; 21; 0; 12; 1; 1; 1; 10; 1; 10; 0; 10; 0; 20; 1; 21; 1; 22; 1; 17; 1; 15; 0; 12; 1; 1; 1; 10; 1; 10; 0; 10; 0; 21; 1; 16; 1; 21; 1; 17; 1; 15; 0; 12; 1; 1; 1; 12; 1; 1; 0 ; -|] -let _htmlstream_char_class : int array = [| -0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 1; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 2; 3; 4; 4; 4; 4; 5; 4; 4; 4; 4; 4; 6; 7; 8; 9; 9; 9; 9; 9; 9; 9; 9; 9; 9; 7; 4; 10; 11; 12; 13; 4; 9; 9; 14; 9; 15; 9; 9; 9; 16; 9; 9; 17; 9; 9; 9; 18; 9; 19; 20; 21; 9; 9; 9; 9; 22; 9; 4; 4; 4; 4; 7; 4; 9; 9; 14; 9; 15; 9; 9; 9; 16; 9; 9; 17; 9; 9; 9; 18; 9; 19; 20; 21; 9; 9; 9; 9; 22; 9; 0 ; -|] -let _htmlstream_index_offsets : int array = [| -0; 10; 20; 43; 44; 66; 72; 78; 84; 96; 118; 141; 164; 187; 210; 223; 236; 246; 249; 252; 275; 287; 292; 297; 320; 343; 366; 389; 402; 412; 425; 438; 448; 451; 454; 477; 482; 487; 510; 522; 544; 566; 576; 586; 597; 618; 632; 651; 667; 685; 706; 719; 720; 730; 740; 751; 772; 793; 815; 832; 847; 860; 861; 871; 881; 892; 914; 930; 951; 968; 983; 996; 997; 1009; 0 ; -|] -let _htmlstream_indices : int array = [| -2; 1; 1; 1; 1; 1; 1; 1; 1; 3; 6; 5; 5; 5; 5; 5; 5; 5; 5; 7; 3; 10; 11; 9; 9; 9; 12; 12; 13; 12; 9; 9; 9; 14; 12; 12; 12; 12; 12; 12; 12; 12; 12; 16; 18; 9; 9; 9; 9; 19; 9; 9; 20; 9; 9; 9; 9; 20; 20; 20; 20; 20; 20; 20; 20; 20; 18; 9; 9; 9; 9; 22; 24; 22; 22; 22; 22; 25; 24; 22; 22; 22; 22; 27; 24; 22; 22; 22; 22; 27; 22; 22; 22; 22; 22; 0; 18; 9; 9; 9; 9; 30; 30; 9; 30; 9; 9; 9; 9; 30; 30; 30; 30; 30; 30; 30; 30; 30; 32; 33; 9; 9; 9; 9; 30; 30; 9; 30; 9; 9; 34; 35; 30; 30; 30; 30; 30; 30; 30; 30; 30; 37; 38; 9; 9; 9; 9; 39; 39; 9; 39; 9; 9; 40; 41; 39; 39; 39; 39; 39; 39; 39; 39; 39; 43; 44; 9; 9; 9; 9; 45; 45; 9; 45; 9; 46; 47; 48; 45; 45; 45; 45; 45; 45; 45; 45; 45; 50; 51; 9; 9; 9; 9; 52; 52; 9; 52; 9; 53; 54; 55; 52; 52; 52; 52; 52; 52; 52; 52; 52; 53; 58; 57; 59; 57; 60; 57; 57; 57; 57; 57; 57; 9; 63; 64; 62; 9; 62; 9; 62; 62; 62; 62; 62; 62; 65; 68; 67; 67; 67; 67; 67; 67; 67; 67; 69; 72; 71; 73; 76; 75; 77; 79; 80; 9; 9; 9; 9; 52; 52; 9; 52; 9; 9; 54; 55; 52; 52; 52; 52; 52; 52; 52; 52; 52; 18; 9; 9; 9; 9; 9; 9; 9; 9; 9; 9; 40; 84; 83; 83; 83; 73; 87; 86; 86; 86; 77; 89; 90; 9; 9; 9; 9; 91; 91; 92; 91; 9; 9; 93; 9; 91; 91; 91; 91; 91; 91; 91; 91; 91; 95; 96; 9; 9; 9; 9; 97; 97; 98; 97; 9; 9; 99; 9; 97; 97; 97; 97; 97; 97; 97; 97; 97; 101; 102; 9; 9; 9; 9; 103; 103; 104; 103; 9; 105; 106; 9; 103; 103; 103; 103; 103; 103; 103; 103; 103; 108; 109; 9; 9; 9; 9; 110; 110; 111; 110; 9; 112; 113; 9; 110; 110; 110; 110; 110; 110; 110; 110; 110; 98; 115; 9; 9; 9; 9; 9; 9; 9; 9; 9; 9; 116; 119; 118; 118; 118; 118; 118; 118; 118; 118; 120; 112; 123; 122; 124; 122; 125; 122; 122; 122; 122; 122; 122; 9; 128; 129; 127; 9; 127; 9; 127; 127; 127; 127; 127; 127; 130; 133; 132; 132; 132; 132; 132; 132; 132; 132; 134; 137; 136; 138; 141; 140; 142; 144; 145; 9; 9; 9; 9; 110; 110; 111; 110; 9; 9; 113; 9; 110; 110; 110; 110; 110; 110; 110; 110; 110; 148; 147; 147; 147; 138; 151; 150; 150; 150; 142; 154; 155; 153; 153; 153; 153; 156; 156; 153; 156; 153; 153; 157; 153; 156; 156; 156; 156; 156; 156; 156; 156; 156; 160; 159; 159; 159; 159; 159; 159; 159; 159; 159; 159; 0; 163; 162; 162; 162; 162; 164; 164; 162; 164; 162; 162; 165; 162; 164; 164; 164; 164; 164; 164; 164; 164; 164; 18; 9; 9; 9; 9; 9; 9; 9; 20; 9; 9; 9; 9; 20; 20; 20; 20; 20; 20; 20; 20; 20; 169; 168; 168; 168; 168; 168; 168; 168; 168; 170; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 174; 175; 171; 171; 171; 171; 171; 171; 176; 171; 173; 176; 177; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 171; 171; 178; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 179; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 171; 180; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 181; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 182; 172; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 171; 171; 171; 171; 171; 171; 171; 171; 171; 183; 183; 184; 171; 171; 171; 171; 171; 171; 171; 171; 173; 171; 185; 187; 190; 189; 189; 189; 189; 189; 189; 189; 189; 191; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 195; 196; 192; 192; 192; 192; 192; 192; 197; 192; 194; 197; 198; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 192; 192; 192; 199; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 192; 192; 192; 192; 200; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 192; 192; 192; 192; 192; 201; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 192; 192; 202; 193; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 192; 192; 192; 203; 203; 204; 192; 192; 192; 192; 192; 192; 192; 192; 194; 192; 205; 207; 210; 209; 209; 209; 209; 209; 209; 209; 209; 211; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 215; 216; 212; 212; 212; 212; 212; 212; 217; 212; 214; 217; 218; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 212; 212; 212; 212; 212; 219; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 220; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 212; 212; 212; 212; 212; 221; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 212; 212; 222; 213; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 212; 212; 212; 223; 223; 224; 212; 212; 212; 212; 212; 212; 212; 212; 214; 212; 225; 227; 229; 228; 228; 228; 228; 228; 228; 228; 228; 228; 228; 230; 232; 0 ; -|] -let _htmlstream_index_defaults : int array = [| -1; 5; 9; 15; 9; 9; 22; 22; 22; 9; 9; 9; 9; 9; 57; 62; 67; 71; 75; 9; 9; 83; 86; 9; 9; 9; 9; 9; 118; 122; 127; 132; 136; 140; 9; 147; 150; 153; 159; 162; 9; 168; 171; 171; 171; 171; 171; 171; 171; 171; 171; 186; 189; 192; 192; 192; 192; 192; 192; 192; 192; 206; 209; 212; 212; 212; 212; 212; 212; 212; 212; 226; 228; 231; 0 ; -|] -let _htmlstream_cond_targs : int array = [| -0; 1; 1; 2; 1; 1; 1; 2; 2; 3; 2; 4; 23; 37; 40; 3; 3; 4; 3; 5; 9; 5; 6; 6; 6; 7; 7; 8; 8; 9; 10; 10; 11; 11; 16; 20; 11; 11; 11; 12; 16; 20; 12; 13; 13; 12; 14; 16; 20; 13; 13; 13; 12; 14; 16; 20; 14; 15; 14; 17; 21; 15; 15; 11; 11; 16; 16; 1; 1; 2; 17; 18; 18; 19; 18; 18; 18; 19; 19; 11; 11; 20; 21; 22; 22; 22; 22; 22; 23; 24; 24; 23; 27; 31; 24; 24; 24; 25; 27; 31; 25; 26; 26; 25; 27; 29; 31; 26; 26; 26; 25; 27; 29; 31; 27; 27; 28; 28; 1; 1; 2; 29; 30; 29; 32; 35; 30; 30; 24; 24; 31; 31; 1; 1; 2; 32; 33; 33; 34; 33; 33; 33; 34; 34; 24; 24; 35; 36; 36; 36; 36; 36; 37; 38; 37; 37; 39; 0; 38; 38; 38; 39; 38; 38; 39; 0; 40; 41; 42; 42; 43; 42; 42; 43; 43; 43; 44; 44; 45; 46; 47; 48; 49; 50; 50; 51; 51; 51; 52; 53; 53; 54; 53; 53; 54; 54; 54; 55; 55; 56; 57; 58; 59; 60; 60; 61; 61; 61; 62; 63; 63; 64; 63; 63; 64; 64; 64; 65; 65; 66; 67; 68; 69; 70; 70; 71; 71; 71; 72; 72; 73; 73; 73; 0 ; -|] -let _htmlstream_cond_actions : int array = [| -0; 1; 2; 0; 3; 0; 4; 3; 5; 5; 4; 6; 7; 6; 6; 0; 4; 5; 8; 0; 1; 5; 0; 5; 4; 0; 5; 0; 5; 5; 0; 5; 9; 10; 9; 9; 5; 0; 4; 1; 0; 0; 5; 11; 12; 0; 11; 13; 13; 5; 0; 4; 14; 0; 15; 15; 5; 1; 4; 0; 0; 5; 0; 16; 17; 16; 18; 19; 20; 18; 5; 1; 2; 21; 5; 0; 4; 22; 5; 15; 23; 5; 5; 1; 2; 5; 0; 4; 5; 24; 25; 0; 24; 24; 5; 0; 4; 1; 0; 0; 5; 11; 12; 0; 13; 11; 13; 5; 0; 4; 14; 15; 0; 15; 5; 4; 0; 26; 27; 28; 26; 5; 1; 4; 0; 0; 5; 0; 16; 17; 16; 29; 30; 31; 29; 5; 1; 2; 21; 5; 0; 4; 22; 5; 15; 23; 5; 1; 2; 5; 0; 4; 5; 32; 0; 4; 1; 32; 5; 0; 4; 5; 33; 34; 0; 33; 5; 0; 1; 35; 21; 0; 4; 22; 0; 4; 0; 4; 0; 0; 0; 0; 0; 0; 4; 36; 0; 4; 0; 1; 35; 21; 0; 4; 22; 0; 4; 0; 4; 0; 0; 0; 0; 0; 4; 37; 0; 4; 0; 1; 35; 21; 0; 4; 22; 0; 4; 0; 4; 0; 0; 0; 0; 0; 4; 38; 0; 4; 0; 4; 39; 0; 4; 0 ; -|] -let _htmlstream_eof_trans : int array = [| -1; 5; 9; 16; 18; 22; 24; 27; 29; 30; 32; 37; 43; 50; 57; 62; 67; 71; 75; 79; 82; 83; 86; 89; 95; 101; 108; 115; 118; 122; 127; 132; 136; 140; 144; 147; 150; 153; 159; 162; 167; 168; 172; 175; 177; 179; 180; 181; 182; 183; 184; 187; 189; 193; 196; 198; 200; 201; 202; 203; 204; 207; 209; 213; 216; 218; 220; 221; 222; 223; 224; 227; 229; 232; 0 ; -|] -let htmlstream_start : int = 0 -let htmlstream_first_final : int = 0 -let htmlstream_error : int = -1 -let htmlstream_en_in_script : int = 41 -let htmlstream_en_in_style : int = 52 -let htmlstream_en_in_title : int = 62 -let htmlstream_en_garbage_tag : int = 72 -let htmlstream_en_main : int = 0 let create data = -let cs = ref 0 in -begin - cs := htmlstream_start; - -end; -let length = String.length data in -{data; - cs; - p = ref 0; - pe = ref length; - eof = ref length; - mark = ref (-1); - mark_end = ref (-1); - tag = ref ""; - key = ref ""; - attrs = ref []; - directive = ref ""; - line = 1; - tokens = Array.make buffer_capacity `EOF; - lines = Array.make buffer_capacity 1; - read = 0; - write = 0; - finished = false} + let cs = ref 0 in + begin + cs := htmlstream_start + end; + let length = String.length data in + { + data; + cs; + p = ref 0; + pe = ref length; + eof = ref length; + mark = ref (-1); + mark_end = ref (-1); + tag = ref ""; + key = ref ""; + attrs = ref []; + directive = ref ""; + line = 1; + tokens = Array.make buffer_capacity `EOF; + lines = Array.make buffer_capacity 1; + read = 0; + write = 0; + finished = false; + } let run scanner = -let data = scanner.data in -let cs = scanner.cs in -let p = scanner.p in -let pe = scanner.pe in -let eof = scanner.eof in -let mark = scanner.mark in -let mark_end = scanner.mark_end in -let tag = scanner.tag in -let key = scanner.key in -let attrs = scanner.attrs in -let directive = scanner.directive in -pe := !eof; -let pause () = -if scanner.write >= buffer_capacity - maximum_transition_output && -!p < !eof then -pe := !p + 1 -in -let substr = String.sub in -let sub () = -assert (!mark >= 0); -if !mark_end < 0 then mark_end := !p; -let text = -if !mark_end <= !mark then "" -else substr data !mark (!mark_end - !mark) -in -mark := -1; -mark_end := -1; -text -in -begin - let _trans : int ref = ref ( 0 ) in - let _keys : int ref = ref 0 in - let _inds : int ref = ref 0 in - let _ic : int ref = ref 0 in - let _have : int ref = ref ( 0 ) in - let _cont : int ref = ref ( 1 ) in - let _again : int ref = ref ( 1 ) in - let _bsc : int ref = ref ( 1 ) in - while _again.contents= 1 && ( p.contents!= pe.contents|| p.contents= eof.contents ) do - begin - _cont := 1; - _again := 1; - if p.contents= eof.contents then - begin - begin - if _htmlstream_eof_trans.(cs.contents)> 0 then - begin - begin - _trans := _htmlstream_eof_trans.(cs.contents)- 1; - - end; - - end - ; - end; - - end - else - begin - begin - _keys := ( cs.contents lsl 1 ); - _inds := _htmlstream_index_offsets.(cs.contents); - if ( Char.code data.[p.contents] )<= 122 && ( Char.code data.[p.contents] )>= 0 then - begin - begin - _ic := _htmlstream_char_class.(( Char.code data.[p.contents] )- 0); - if _ic.contents<= _htmlstream_trans_keys.( _keys.contents+1 )&& _ic.contents>= _htmlstream_trans_keys.( _keys.contents ) then - begin - _trans := _htmlstream_indices.( _inds.contents+ ( _ic.contents- _htmlstream_trans_keys.( _keys.contents ) ) ); - - end - else - begin - _trans := _htmlstream_index_defaults.(cs.contents); - - end - ; - end; - - end - else - begin - begin - _trans := _htmlstream_index_defaults.(cs.contents); - - end; - - end - ; - end; - - end - ;cs := _htmlstream_cond_targs.(_trans.contents); - if _htmlstream_cond_actions.(_trans.contents)!= 0 then - begin - begin - if _htmlstream_cond_actions.(_trans.contents) = 1 then - begin - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 22 then - begin - begin - mark_end := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 24 then - begin - begin - tag := String.lowercase_ascii @@ sub (); attrs := []; - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 33 then - begin - begin - let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (`End (make_tag name [])); - pause () - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 9 then - begin - begin - directive := String.lowercase_ascii @@ sub (); attrs := []; - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 3 then - begin - begin - emit scanner (`String (decode (sub ()))); - pause (); - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 11 then - begin - begin - key := String.lowercase_ascii @@ sub () - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 15 then - begin - begin - attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 29 then - begin - begin - match !tag with - | "script" -> begin - p := p.contents- 1; - - end; - begin - cs := 41; - - end; - | "style" -> begin - p := p.contents- 1; - - end; - begin - cs := 52; - - end; - | "title" -> begin - p := p.contents- 1; - - end; - begin - cs := 62; - - end; - | "" -> () - | name -> - emit scanner (`Start (make_tag name (attributes !attrs))); - pause (); - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 26 then - begin - begin - let start = `Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [start; `End (make_tag !tag [])]; - pause (); - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 18 then - begin - begin - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 5 then - begin - begin - begin - p := p.contents- 1; - - end; - begin - cs := 72; - - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 4 then - begin - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 6 then - begin - begin - tag := "" - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 21 then - begin - begin - mark := !p - end; - begin - mark_end := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 32 then - begin - begin - mark := !p - end; - begin - let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (`End (make_tag name [])); - pause () - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 2 then - begin - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 16 then - begin - begin - mark_end := !p - end; - begin - attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 25 then - begin - begin - tag := String.lowercase_ascii @@ sub (); attrs := []; - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 34 then - begin - begin - let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (`End (make_tag name [])); - pause () - end; - - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 10 then - begin - begin - directive := String.lowercase_ascii @@ sub (); attrs := []; - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 13 then - begin - begin - key := String.lowercase_ascii @@ sub () - end; - begin - attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 12 then - begin - begin - key := String.lowercase_ascii @@ sub () - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 14 then - begin - begin - attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 23 then - begin - begin - attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 30 then - begin - begin - match !tag with - | "script" -> begin - p := p.contents- 1; - - end; - begin - cs := 41; - - end; - | "style" -> begin - p := p.contents- 1; - - end; - begin - cs := 52; - - end; - | "title" -> begin - p := p.contents- 1; - - end; - begin - cs := 62; - - end; - | "" -> () - | name -> - emit scanner (`Start (make_tag name (attributes !attrs))); - pause (); - - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 39 then - begin - begin - match !tag with - | "script" -> begin - p := p.contents- 1; - - end; - begin - cs := 41; - - end; - | "style" -> begin - p := p.contents- 1; - - end; - begin - cs := 52; - - end; - | "title" -> begin - p := p.contents- 1; - - end; - begin - cs := 62; - - end; - | "" -> () - | name -> - emit scanner (`Start (make_tag name (attributes !attrs))); - pause (); - - end; - begin - begin - cs := 0; - - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 27 then - begin - begin - let start = `Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [start; `End (make_tag !tag [])]; - pause (); - - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 19 then - begin - begin - - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 8 then - begin - begin - begin - p := p.contents- 1; - - end; - begin - cs := 72; - - end; - - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 35 then - begin - begin - scanner.line <- scanner.line + 1 - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 36 then - begin - begin - emit_many scanner - [`Start (make_tag "script" (attributes !attrs)); - `String (sub ()); - `End (make_tag "script" [])]; - pause (); - - end; - begin - begin - cs := 0; - - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 37 then - begin - begin - emit_many scanner - [`Start (make_tag "style" (attributes !attrs)); - `String (sub ()); - `End (make_tag "style" [])]; - pause (); - - end; - begin - begin - cs := 0; - - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 38 then - begin - begin - emit_many scanner - [`Start (make_tag "title" (attributes !attrs)); - `String (decode (sub ())); - `End (make_tag "title" [])]; - pause (); - - end; - begin - begin - cs := 0; - - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 7 then - begin - begin - tag := "" - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 17 then - begin - begin - mark_end := !p - end; - begin - attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 31 then - begin - begin - match !tag with - | "script" -> begin - p := p.contents- 1; - - end; - begin - cs := 41; - - end; - | "style" -> begin - p := p.contents- 1; - - end; - begin - cs := 52; - - end; - | "title" -> begin - p := p.contents- 1; - - end; - begin - cs := 62; - - end; - | "" -> () - | name -> - emit scanner (`Start (make_tag name (attributes !attrs))); - pause (); - - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 28 then - begin - begin - let start = `Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [start; `End (make_tag !tag [])]; - pause (); - - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 20 then - begin - begin - - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - ; - - end; - - end - ;if _cont.contents= 1 then - begin - begin - if p.contents= eof.contents then - begin - begin - if cs.contents>= 0 then - begin - begin - _cont := 0; - _again := 0; - - end; - - end - ; - end; - - end - else - begin - begin - p := p.contents + 1; - begin - _cont := 0; - _again := 1; - - end; - - end; - - end - ;if _cont.contents= 1 then - begin - begin - begin - _cont := 0; - _again := 0; - - end; - - end; - - end - ; - end; - - end - ; - end; - - done; - -end; -if !p >= !eof then scanner.finished <- true -else if scanner.write = 0 then scanner.finished <- true - -let rec next scanner (_state : Html_tokenizer.state) -(location : location_out) = -if scanner.read < scanner.write then begin - let index = scanner.read in - let token = scanner.tokens.(index) in - location.line <- scanner.lines.(index); - location.column <- -1; - scanner.tokens.(index) <- `EOF; - scanner.read <- index + 1; - token -end -else if scanner.finished then begin - location.line <- scanner.line; - location.column <- -1; - `EOF -end -else begin - scanner.read <- 0; - scanner.write <- 0; - run scanner; - next scanner _state location -end + let data = scanner.data in + let cs = scanner.cs in + let p = scanner.p in + let pe = scanner.pe in + let eof = scanner.eof in + let mark = scanner.mark in + let mark_end = scanner.mark_end in + let tag = scanner.tag in + let key = scanner.key in + let attrs = scanner.attrs in + let directive = scanner.directive in + pe := !eof; + let pause () = + if scanner.write >= buffer_capacity - maximum_transition_output && !p < !eof + then pe := !p + 1 + in + let substr = String.sub in + let sub () = + assert (!mark >= 0); + if !mark_end < 0 then mark_end := !p; + let text = + if !mark_end <= !mark then "" else substr data !mark (!mark_end - !mark) + in + mark := -1; + mark_end := -1; + text + in + begin + let _trans : int ref = ref 0 in + let _keys : int ref = ref 0 in + let _inds : int ref = ref 0 in + let _ic : int ref = ref 0 in + let _have : int ref = ref 0 in + let _cont : int ref = ref 1 in + let _again : int ref = ref 1 in + let _bsc : int ref = ref 1 in + while + _again.contents = 1 + && (p.contents != pe.contents || p.contents = eof.contents) + do + begin + _cont := 1; + _again := 1; + if p.contents = eof.contents then begin + begin if _htmlstream_eof_trans.(cs.contents) > 0 then begin begin + _trans := _htmlstream_eof_trans.(cs.contents) - 1 + end + end + end + end + else begin begin + _keys := cs.contents lsl 1; + _inds := _htmlstream_index_offsets.(cs.contents); + if + Char.code data.[p.contents] <= 122 + && Char.code data.[p.contents] >= 0 + then begin begin + _ic := _htmlstream_char_class.(Char.code data.[p.contents] - 0); + if + _ic.contents <= _htmlstream_trans_keys.(_keys.contents + 1) + && _ic.contents >= _htmlstream_trans_keys.(_keys.contents) + then begin + _trans := + _htmlstream_indices.(_inds.contents + + (_ic.contents + - _htmlstream_trans_keys.(_keys + .contents) + )) + end + else begin + _trans := _htmlstream_index_defaults.(cs.contents) + end + end + end + else begin begin + _trans := _htmlstream_index_defaults.(cs.contents) + end + end + end + end; + cs := _htmlstream_cond_targs.(_trans.contents); + if _htmlstream_cond_actions.(_trans.contents) != 0 then begin + begin if _htmlstream_cond_actions.(_trans.contents) = 1 then begin + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 22 then begin + begin + mark_end := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 24 then begin + begin + tag := String.lowercase_ascii @@ sub (); + attrs := [] + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 33 then begin + begin + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 9 then begin + begin + directive := String.lowercase_ascii @@ sub (); + attrs := [] + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 3 then begin + begin + emit scanner (`String (decode (sub ()))); + pause () + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 11 then begin + begin + key := String.lowercase_ascii @@ sub () + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 15 then begin + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 29 then begin + begin match !tag with + | "script" -> + begin + p := p.contents - 1 + end; + begin + cs := 41 + end + | "style" -> + begin + p := p.contents - 1 + end; + begin + cs := 52 + end + | "title" -> + begin + p := p.contents - 1 + end; + begin + cs := 62 + end + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause () + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 26 then begin + begin + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; `End (make_tag !tag []) ]; + pause () + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 18 then begin + begin end + end + else if _htmlstream_cond_actions.(_trans.contents) = 5 then begin + begin + begin + p := p.contents - 1 + end; + begin + cs := 72 + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 4 then begin + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 6 then begin + begin + tag := "" + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 21 then begin + begin + mark := !p + end; + begin + mark_end := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 32 then begin + begin + mark := !p + end; + begin + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 2 then begin + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 16 then begin + begin + mark_end := !p + end; + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 25 then begin + begin + tag := String.lowercase_ascii @@ sub (); + attrs := [] + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 34 then begin + begin + let name = String.lowercase_ascii @@ sub () in + if name <> "br" then begin + emit scanner (`End (make_tag name [])); + pause () + end + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 10 then begin + begin + directive := String.lowercase_ascii @@ sub (); + attrs := [] + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 13 then begin + begin + key := String.lowercase_ascii @@ sub () + end; + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 12 then begin + begin + key := String.lowercase_ascii @@ sub () + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 14 then begin + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 23 then begin + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 30 then begin + begin match !tag with + | "script" -> + begin + p := p.contents - 1 + end; + begin + cs := 41 + end + | "style" -> + begin + p := p.contents - 1 + end; + begin + cs := 52 + end + | "title" -> + begin + p := p.contents - 1 + end; + begin + cs := 62 + end + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause () + end; + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 39 then begin + begin match !tag with + | "script" -> + begin + p := p.contents - 1 + end; + begin + cs := 41 + end + | "style" -> + begin + p := p.contents - 1 + end; + begin + cs := 52 + end + | "title" -> + begin + p := p.contents - 1 + end; + begin + cs := 62 + end + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause () + end; + begin + begin + cs := 0 + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 27 then begin + begin + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; `End (make_tag !tag []) ]; + pause () + end; + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 19 then begin + begin end; + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 8 then begin + begin + begin + p := p.contents - 1 + end; + begin + cs := 72 + end + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 35 then begin + begin + scanner.line <- scanner.line + 1 + end; + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 36 then begin + begin + emit_many scanner + [ + `Start (make_tag "script" (attributes !attrs)); + `String (sub ()); + `End (make_tag "script" []); + ]; + pause () + end; + begin + begin + cs := 0 + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 37 then begin + begin + emit_many scanner + [ + `Start (make_tag "style" (attributes !attrs)); + `String (sub ()); + `End (make_tag "style" []); + ]; + pause () + end; + begin + begin + cs := 0 + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 38 then begin + begin + emit_many scanner + [ + `Start (make_tag "title" (attributes !attrs)); + `String (decode (sub ())); + `End (make_tag "title" []); + ]; + pause () + end; + begin + begin + cs := 0 + end + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 7 then begin + begin + tag := "" + end; + begin + mark := !p + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 17 then begin + begin + mark_end := !p + end; + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 31 then begin + begin match !tag with + | "script" -> + begin + p := p.contents - 1 + end; + begin + cs := 41 + end + | "style" -> + begin + p := p.contents - 1 + end; + begin + cs := 52 + end + | "title" -> + begin + p := p.contents - 1 + end; + begin + cs := 62 + end + | "" -> () + | name -> + emit scanner (`Start (make_tag name (attributes !attrs))); + pause () + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 28 then begin + begin + let start = `Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; `End (make_tag !tag []) ]; + pause () + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end + end + else if _htmlstream_cond_actions.(_trans.contents) = 20 then begin + begin end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end + end + end + end; + if _cont.contents = 1 then begin begin + if p.contents = eof.contents then begin + begin if cs.contents >= 0 then begin begin + _cont := 0; + _again := 0 + end + end + end + end + else begin begin + p := p.contents + 1; + begin + _cont := 0; + _again := 1 + end + end + end; + if _cont.contents = 1 then begin begin + begin + _cont := 0; + _again := 0 + end + end + end + end + end + end + done + end; + if !p >= !eof then scanner.finished <- true + else if scanner.write = 0 then scanner.finished <- true + +let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = + if scanner.read < scanner.write then begin + let index = scanner.read in + let token = scanner.tokens.(index) in + location.line <- scanner.lines.(index); + location.column <- -1; + scanner.tokens.(index) <- `EOF; + scanner.read <- index + 1; + token + end + else if scanner.finished then begin + location.line <- scanner.line; + location.column <- -1; + `EOF + end + else begin + scanner.read <- 0; + scanner.write <- 0; + run scanner; + next scanner _state location + end diff --git a/src/lite/ragel_html_tokenizer.mli b/src/lite/ragel_html_tokenizer.mli index 5229b39..18b19b3 100644 --- a/src/lite/ragel_html_tokenizer.mli +++ b/src/lite/ragel_html_tokenizer.mli @@ -1,14 +1,8 @@ (* Derived from Devkit's htmlStream_ragel.ml.rl. Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. *) -type location_out = { - mutable line : int; - mutable column : int; -} - +type location_out = { mutable line : int; mutable column : int } type t val create : string -> t - -val next : - t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token +val next : t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token diff --git a/src/lite/text.ml b/src/lite/text.ml index ad8cf89..cc14cd5 100644 --- a/src/lite/text.ml +++ b/src/lite/text.ml @@ -3,15 +3,15 @@ open Common -type t = - {mutable strings : string list; - buffer : Buffer.t; - mutable location : location option} +type t = { + mutable strings : string list; + buffer : Buffer.t; + mutable location : location option; +} (* This is changed for unit testing. *) let length_limit = ref (Sys.max_string_length / 2) - -let prepare () = {strings = []; buffer = Buffer.create 256; location = None} +let prepare () = { strings = []; buffer = Buffer.create 256; location = None } let note_location text location = begin match text.location with @@ -23,7 +23,7 @@ let adding text location = note_location text location; if Buffer.length text.buffer >= !length_limit then begin - text.strings <- (Buffer.contents text.buffer)::text.strings; + text.strings <- Buffer.contents text.buffer :: text.strings; Buffer.clear text.buffer end @@ -41,11 +41,11 @@ let emit text = match text.location with | None -> None | Some location -> - text.location <- None; - if Buffer.length text.buffer = 0 then None - else begin - let strings = (Buffer.contents text.buffer)::text.strings |> List.rev in - text.strings <- []; - Buffer.clear text.buffer; - Some (location, strings) - end + text.location <- None; + if Buffer.length text.buffer = 0 then None + else begin + let strings = Buffer.contents text.buffer :: text.strings |> List.rev in + text.strings <- []; + Buffer.clear text.buffer; + Some (location, strings) + end diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 12e9d43..799d7ce 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -8,30 +8,24 @@ type location_out = Ragel_html_tokenizer.location_out = { mutable column : int; } -type pushed_token = { - token : Html_tokenizer.token; - line : int; - column : int; -} +type pushed_token = { token : Html_tokenizer.token; line : int; column : int } type t = { scanner : Ragel_html_tokenizer.t; mutable pushed : pushed_token list; } -let create html = - {scanner = Ragel_html_tokenizer.create html; pushed = []} - -let location () = {line = 1; column = -1} +let create html = { scanner = Ragel_html_tokenizer.create html; pushed = [] } +let location () = { line = 1; column = -1 } let next source state (out : location_out) = match source.pushed with - | {token; line; column}::rest -> - source.pushed <- rest; - out.line <- line; - out.column <- column; - token + | { token; line; column } :: rest -> + source.pushed <- rest; + out.line <- line; + out.column <- column; + token | [] -> Ragel_html_tokenizer.next source.scanner state out let push source ((line, column), token) = - source.pushed <- {token; line; column}::source.pushed + source.pushed <- { token; line; column } :: source.pushed diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli index 65e5076..315c658 100644 --- a/src/lite/token_source.mli +++ b/src/lite/token_source.mli @@ -3,17 +3,10 @@ open Common -type location_out = { - mutable line : int; - mutable column : int; -} - +type location_out = { mutable line : int; mutable column : int } type t val create : string -> t val location : unit -> location_out - -val next : - t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token - +val next : t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token val push : t -> location * Html_tokenizer.token -> unit From b9c53e7b1ac2632f7dddf390635b1bf0d0ffc9df Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 11:53:26 -0400 Subject: [PATCH 016/109] `make format` target --- Makefile | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Makefile b/Makefile index 3f6e41a..51f3233 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,10 @@ build : dune build -p markup,markup-lwt +.PHONY : format +format : + dune build @src/lite/fmt --auto-promote || dune build @src/lite/fmt + # This is not part of the ordinary build process. The output file, entities.ml, # is checked into git. .PHONY : entities From 14d0e01687679d01d82a7bc29f9894c63818c38e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 12:07:39 -0400 Subject: [PATCH 017/109] ocamlformat ignore src/ --- src/.ocamlformat-ignore | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 src/.ocamlformat-ignore diff --git a/src/.ocamlformat-ignore b/src/.ocamlformat-ignore new file mode 100644 index 0000000..812c264 --- /dev/null +++ b/src/.ocamlformat-ignore @@ -0,0 +1,6 @@ +*.ml +*.mli +common/** +entities/** +lwt/** +lwt_unix/** From 07b216770f1870130de1e542cdf85fc0a46edac1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 12:07:55 -0400 Subject: [PATCH 018/109] handle depth_limit in markup.lite --- src/lite/markup_lite.ml | 5 +++-- src/lite/markup_lite.mli | 1 + test/lite/lite_diff_corpus.ml | 19 +++++++++++++++++++ test/lite/oracle.ml | 7 +++---- 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index 79fd5c1..ad44639 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -29,14 +29,15 @@ module Ns = Markup_common.Ns let signal_to_string = Markup_common.signal_to_string let parse_html ?(report = fun _ _ -> ()) - ?(context : [ `Document | `Fragment of string ] = `Document) html = + ?(context : [ `Document | `Fragment of string ] = `Document) ?depth_limit + html = let report location error throw resume = match report location error with | () -> resume () | exception exn -> throw exn in let tokens = Token_source.create html in - Html_parser.parse context report tokens + Html_parser.parse ?depth_limit context report tokens |> Kstream.map (fun (_, signal) _ continue -> continue signal) |> Markup_common.Stream.Private.to_stream |> fun stream -> (stream : (signal, sync) stream) diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index 8131d73..b2ad99d 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -33,6 +33,7 @@ val signal_to_string : [< signal ] -> string val parse_html : ?report:(location -> Error.t -> unit) -> ?context:[ `Document | `Fragment of string ] -> + ?depth_limit:int -> string -> (signal, sync) stream diff --git a/test/lite/lite_diff_corpus.ml b/test/lite/lite_diff_corpus.ml index 721a4df..b2c6991 100644 --- a/test/lite/lite_diff_corpus.ml +++ b/test/lite/lite_diff_corpus.ml @@ -95,7 +95,26 @@ let compare path oracle lite = Printf.eprintf "%s: Lite raised but oracle did not: %s\n" path exn; false +let check_depth_limit () = + let html = "
" in + let oracle = + run (Oracle.parse ~depth_limit:1) (collect Markup.iter) html + in + let lite = + run + (fun report html -> + Markup_lite.parse_html ~report ~depth_limit:1 html) + (collect Markup_lite.iter) html + in + match oracle, lite with + | Raised _, Raised _ -> + if not (compare "depth-limit check" oracle lite) then exit 1 + | _ -> + Printf.eprintf "depth-limit check: expected both parsers to raise\n"; + exit 1 + let () = + check_depth_limit (); let directory = match Array.to_list Sys.argv with | [_; directory] -> directory diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index 09ef2bc..6328c0e 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -32,8 +32,7 @@ let tokenize html : (Markup.location * Markup.Internals.token) list = emit `EOF; List.rev !tokens -let parse report html = - html - |> tokenize - |> Markup.Internals.parse_tokens ~report ~context:`Document +let parse ?depth_limit report html = + html |> tokenize + |> Markup.Internals.parse_tokens ?depth_limit ~report ~context:`Document |> Markup.signals From d3515aa9355ef742d1d0887db7ea3b05d1fdab6d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 12:52:38 -0400 Subject: [PATCH 019/109] format lite --- src/lite/dune | 5 +++++ src/lite/html_entity_decoder.ml | 6 +++--- src/lite/html_parser.ml | 30 +++++++++++++++--------------- src/lite/html_writer.ml | 6 +++--- 4 files changed, 26 insertions(+), 21 deletions(-) diff --git a/src/lite/dune b/src/lite/dune index 55ffb7e..86257b5 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -1,3 +1,8 @@ +(env + (afl + (ocamlopt_flags + (:standard -afl-instrument -afl-inst-ratio 20)))) + (library (name markup_lite) (public_name markup.lite) diff --git a/src/lite/html_entity_decoder.ml b/src/lite/html_entity_decoder.ml index f10e44e..b7e0e0f 100644 --- a/src/lite/html_entity_decoder.ml +++ b/src/lite/html_entity_decoder.ml @@ -94,14 +94,14 @@ let decode text = add_utf_8 buffer text copied (index - copied); begin match value with | `Codepoint codepoint -> add_uchar buffer codepoint - | `Name name -> begin - match Hashtbl.find_opt (Lazy.force named_entities) name with + | `Name name -> + begin match Hashtbl.find_opt (Lazy.force named_entities) name with | Some (`One codepoint) -> add_uchar buffer codepoint | Some (`Two (first, second)) -> add_uchar buffer first; add_uchar buffer second | None -> Uutf.Buffer.add_utf_8 buffer replacement - end + end end; search after after and reference_end text start = diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index aae9e85..b024ffa 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -859,11 +859,11 @@ end = struct let end_signal = (end_location, `End_element) in start_signal :: List.fold_left (traverse (depth - 1)) (end_signal :: acc) children - | l, Text ss -> begin - match acc with + | l, Text ss -> + begin match acc with | (_, `Text ss') :: rest -> (l, `Text (ss @ ss')) :: rest | _ -> (l, `Text ss) :: acc - end + end | l, PI (t, s) -> (l, `PI (t, s)) :: acc | l, Comment s -> (l, `Comment s) :: acc in @@ -999,16 +999,17 @@ end = struct let outer_loop_counter = outer_loop_counter + 1 in if outer_loop_counter >= 8 then (true, List.rev errors) - else begin - match find_formatting_element () with + else + begin match find_formatting_element () with | None -> (false, List.rev errors) | Some formatting_element -> if not formatting_element.is_open then begin Active.remove active_formatting_elements formatting_element; (true, List.rev ((l, `Unmatched_end_tag subject) :: errors)) end - else begin - if not @@ Stack.target_in_scope stack formatting_element then begin + else + begin if not @@ Stack.target_in_scope stack formatting_element + then begin (true, List.rev ((l, `Unmatched_end_tag subject) :: errors)) end else begin @@ -1071,8 +1072,8 @@ end = struct outer_loop outer_loop_counter errors end - end - end + end + end in let current_node = Stack.require_current_element stack in @@ -1197,11 +1198,10 @@ let parse ?depth_limit requested_context report tokens = and reset_mode () = let rec iterate last = function | [ e ] when (not last) && Context.the_context context <> `Document -> - begin - match Context.the_context context with + begin match Context.the_context context with | `Document -> assert false | `Fragment name -> iterate true [ { e with element_name = name } ] - end + end | { element_name = _, "select" } :: ancestors -> let rec iterate' = function | [] -> in_select_mode @@ -1217,11 +1217,11 @@ let parse ?depth_limit requested_context report tokens = | { element_name = _, "caption" } :: _ -> in_caption_mode | { element_name = _, "colgroup" } :: _ -> in_column_group_mode | { element_name = _, "table" } :: _ -> in_table_mode - | { element_name = _, "template" } :: _ -> begin - match !template_insertion_modes with + | { element_name = _, "template" } :: _ -> + begin match !template_insertion_modes with | [] -> initial_mode (* This is an internal error, actually. *) | mode :: _ -> mode - end + end (* The next case corresponds to item 12 of "Resetting the insertion mode appropriately." It is commented out as deliberate deviation from the specification, because that makes parsing of fragments intended for diff --git a/src/lite/html_writer.ml b/src/lite/html_writer.ml index 35d397f..933db7e 100644 --- a/src/lite/html_writer.ml +++ b/src/lite/html_writer.ml @@ -142,8 +142,8 @@ let write ?(escape_attribute = escape_attribute) ?(escape_text = escape_text) loop throw ended) else loop throw ended end - | `End_element -> begin - match !open_elements with + | `End_element -> + begin match !open_elements with | [] -> loop throw ended | name :: rest -> open_elements := rest; @@ -151,7 +151,7 @@ let write ?(escape_attribute = escape_attribute) ?(escape_text = escape_text) Buffer.add_string buffer name; Buffer.add_char buffer '>'; loop throw ended - end + end | `Text strings -> if List.for_all (fun s -> String.length s = 0) strings then loop throw ended From 7d3de56825238191f589e421d6884736420e41c0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 26 Aug 2026 12:52:58 -0400 Subject: [PATCH 020/109] add afl fuzz --- .gitignore | 3 ++ Makefile | 38 ++++++++++++++ dune | 4 ++ test/fuzz/dune | 8 +++ test/fuzz/html.dict | 22 ++++++++ test/fuzz/lite_diff_fuzz.ml | 95 ++++++++++++++++++++++++++++++++++ test/fuzz/seeds/empty.html | 0 test/fuzz/seeds/foreign.html | 1 + test/fuzz/seeds/malformed.html | 1 + test/fuzz/seeds/script.html | 1 + test/fuzz/seeds/table.html | 1 + test/fuzz/seeds/tags.html | 1 + test/fuzz/seeds/text.html | 1 + test/lite/dune | 10 +++- 14 files changed, 184 insertions(+), 2 deletions(-) create mode 100644 dune create mode 100644 test/fuzz/dune create mode 100644 test/fuzz/html.dict create mode 100644 test/fuzz/lite_diff_fuzz.ml create mode 100644 test/fuzz/seeds/empty.html create mode 100644 test/fuzz/seeds/foreign.html create mode 100644 test/fuzz/seeds/malformed.html create mode 100644 test/fuzz/seeds/script.html create mode 100644 test/fuzz/seeds/table.html create mode 100644 test/fuzz/seeds/tags.html create mode 100644 test/fuzz/seeds/text.html diff --git a/.gitignore b/.gitignore index cfd064a..9d11928 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,9 @@ scratch/ _opam/ _build/ +_build-*/ +_fuzz/ +_tools/ bisect*.out _coverage *.install diff --git a/Makefile b/Makefile index 51f3233..a4675b2 100644 --- a/Makefile +++ b/Makefile @@ -35,6 +35,44 @@ test-lite : $(LITE_TEST_EXE) $(LITE_TEST_CORPUS) $(LITE_WRITER_TEST_EXE) $(LITE_TEST_CORPUS) +LITE_AFL_EXE := _build-afl/default/test/fuzz/lite_diff_fuzz.exe +LITE_AFL_OUTPUT ?= _fuzz/lite +AFL_FUZZ ?= $(if $(wildcard _tools/AFLplusplus/afl-fuzz),_tools/AFLplusplus/afl-fuzz,afl-fuzz) +J ?= 4 + +.PHONY : test-lite-afl +test-lite-afl : + @command -v $(AFL_FUZZ) >/dev/null || { \ + echo "$(AFL_FUZZ) not found; install AFL or set AFL_FUZZ" >&2; exit 1; } + dune build --build-dir _build-afl --profile afl \ + test/fuzz/lite_diff_fuzz.exe + @set -eu; \ + case "$(J)" in ''|*[!0-9]*|0) echo "J must be a positive integer" >&2; exit 2;; esac; \ + mkdir -p $(LITE_AFL_OUTPUT); \ + pids=''; \ + cleanup () { \ + trap - EXIT INT TERM; \ + if test -n "$$pids"; then kill $$pids 2>/dev/null || true; fi; \ + wait 2>/dev/null || true; \ + }; \ + trap cleanup EXIT INT TERM; \ + i=0; \ + while test $$i -lt $(J); do \ + id=$$(printf 'fuzzer%02d' $$i); \ + if test $$i -eq 0; then role=-M; else role=-S; fi; \ + input=test/fuzz/seeds; \ + if test -d $(LITE_AFL_OUTPUT)/$$id/queue; then input=-; fi; \ + echo "starting AFL worker $$id"; \ + AFL_NO_UI=1 AFL_NO_AFFINITY=1 AFL_SKIP_CPUFREQ=1 \ + AFL_I_DONT_CARE_ABOUT_MISSING_CRASHES=1 \ + $(AFL_FUZZ) -i $$input -o $(LITE_AFL_OUTPUT) \ + -x test/fuzz/html.dict $$role $$id -- $(LITE_AFL_EXE) \ + >$(LITE_AFL_OUTPUT)/$$id.log 2>&1 & \ + pids="$$pids $$!"; \ + i=$$((i + 1)); \ + done; \ + wait + .PHONY : coverage coverage : find . -name '*.coverage' | xargs rm -f diff --git a/dune b/dune new file mode 100644 index 0000000..f819bdc --- /dev/null +++ b/dune @@ -0,0 +1,4 @@ +(env + (afl + (flags + (:standard -warn-error -A)))) diff --git a/test/fuzz/dune b/test/fuzz/dune new file mode 100644 index 0000000..8f962e8 --- /dev/null +++ b/test/fuzz/dune @@ -0,0 +1,8 @@ +(env + (afl + (ocamlopt_flags + (:standard -afl-instrument -afl-inst-ratio 20)))) + +(executable + (name lite_diff_fuzz) + (libraries lite_test_oracle markup markup.common markup.lite unix uutf)) diff --git a/test/fuzz/html.dict b/test/fuzz/html.dict new file mode 100644 index 0000000..fc276c8 --- /dev/null +++ b/test/fuzz/html.dict @@ -0,0 +1,22 @@ +open="<" +close="" +self_close="/>" +comment_open="" +script_open="" +style_open="" +table_open="" +table_close="
" +template_open="" +svg_open="" +math_open="" +amp="&" +decimal="&#" +hex="&#x" +quote="\"" +apostrophe="'" +equals="=" diff --git a/test/fuzz/lite_diff_fuzz.ml b/test/fuzz/lite_diff_fuzz.ml new file mode 100644 index 0000000..2e014ce --- /dev/null +++ b/test/fuzz/lite_diff_fuzz.ml @@ -0,0 +1,95 @@ +let maximum_input_length = 1024 * 1024 + +let read_input channel = + let buffer = Buffer.create 4096 in + let bytes = Bytes.create 65536 in + let rec read total = + let count = input channel bytes 0 (Bytes.length bytes) in + if count = 0 then Some (Buffer.contents buffer) + else + let total = total + count in + if total > maximum_input_length then None + else begin + Buffer.add_subbytes buffer bytes 0 count; + read total + end + in + read 0 + +let valid_utf_8 input = + try + Uutf.String.fold_utf_8 + (fun () _ -> function `Uchar _ -> () | `Malformed _ -> raise Exit) + () input; + true + with Exit -> false + +let collect iter stream = + let values = ref [] in + iter (fun value -> values := value :: !values) stream; + List.rev !values + +type outcome = Signals of Markup_common.signal list | Raised of string + +let run parse collect_signals input = + try Signals (collect_signals (parse input)) + with exn -> Raised (Printexc.to_string exn) + +let oracle input = + run + (fun input -> Oracle.parse (fun _ _ -> ()) input) + (collect Markup.iter) input + +let lite input = + run + (fun input -> Markup_lite.parse_html input) + (collect Markup_lite.iter) input + +let truncate string = + let maximum = 240 in + if String.length string <= maximum then string + else String.sub string 0 maximum ^ "..." + +let signal = function + | None -> "" + | Some signal -> + Markup_common.signal_to_string signal |> truncate |> Printf.sprintf "%S" + +let first = function [] -> None | value :: _ -> Some value + +let crash format = + Printf.ksprintf + (fun message -> + Printf.eprintf "markup.lite differential mismatch: %s\n%!" message; + Unix.kill (Unix.getpid ()) Sys.sigabrt; + exit 2) + format + +let compare_signals expected actual = + let rec compare index expected actual = + match (expected, actual) with + | [], [] -> () + | expected :: expected_rest, actual :: actual_rest when expected = actual -> + compare (index + 1) expected_rest actual_rest + | expected, actual -> + crash "signal %d: oracle=%s lite=%s" index + (signal (first expected)) + (signal (first actual)) + in + compare 0 expected actual + +let check input = + match (oracle input, lite input) with + | Signals expected, Signals actual -> compare_signals expected actual + | Raised expected, Raised actual when expected = actual -> () + | Raised expected, Raised actual -> + crash "exceptions differ: oracle=%S lite=%S" expected actual + | Raised exception_, Signals _ -> + crash "oracle raised but Lite returned signals: %S" exception_ + | Signals _, Raised exception_ -> + crash "Lite raised but oracle returned signals: %S" exception_ + +let () = + match read_input stdin with + | Some input when valid_utf_8 input -> check input + | Some _ | None -> () diff --git a/test/fuzz/seeds/empty.html b/test/fuzz/seeds/empty.html new file mode 100644 index 0000000..e69de29 diff --git a/test/fuzz/seeds/foreign.html b/test/fuzz/seeds/foreign.html new file mode 100644 index 0000000..2ee3284 --- /dev/null +++ b/test/fuzz/seeds/foreign.html @@ -0,0 +1 @@ +

xy diff --git a/test/fuzz/seeds/malformed.html b/test/fuzz/seeds/malformed.html new file mode 100644 index 0000000..aa7323c --- /dev/null +++ b/test/fuzz/seeds/malformed.html @@ -0,0 +1 @@ +

x

"; + agrees "empty" "ab"; + ]; + "doctype" + >::: [ + agrees "lowercase" "

x

"; + agrees "uppercase" "text"; + ]; + "br end tag" + >::: [ agrees "between text" "x
y"; agrees "alone" "
" ]; + "self-closing" + >::: [ agrees "div" "
x"; agrees "span and b" "xy" ]; + "rcdata" + >::: [ + agrees "textarea start tag" ""; + agrees "textarea end tag" "x"; + ]; + "script escaping" + >::: [ + agrees "escaped close tag" + " -->"; + agrees "double escaped" + "y"; + ]; + "lenient entities" + >::: [ + agrees "named without semicolon" "a&b"; + agrees "numeric without semicolon" "x&y"; + agrees "attribute named without semicolon" + "

x

"; + ]; + "invalid utf8" + >::: [ + agrees "leading byte" "\xff

x

"; + agrees "byte in text" "

a\xffb

"; + agrees "continuation bytes" "\xb5\x95"; + ]; + "crlf" + >::: [ + agrees "crlf in text" "

a\r\nb

"; agrees "lone cr" "a\rb"; + ]; + "garbage tags" + >::: [ + agrees "at sign in name" "z"; + agrees "with attribute and end tag" + "t"; + ]; + "fragment foreign" + >::: [ + agrees ~context:(`Fragment "svg") "td in svg" "x"; + agrees ~context:(`Fragment "svg") "div span in svg" + "
"; + ]; + ]) diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index 789bb27..5b62f01 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -32,7 +32,8 @@ let tokenize html : (Markup.location * Markup.Internals.token) list = emit `EOF; List.rev !tokens -let parse ?depth_limit report html = +let parse ?depth_limit + ?(context : [ `Document | `Fragment of string ] = `Document) report html = html |> tokenize - |> Markup.Internals.parse_tokens ?depth_limit ~report ~context:`Document + |> Markup.Internals.parse_tokens ?depth_limit ~report ~context |> Markup.signals From 66ffebb3b3f3069cee807db5778288bab12511ae Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 16:26:57 +0000 Subject: [PATCH 045/109] fix: replace invalid utf8 in lite input with U+FFFD like src/baseline --- src/lite/token_source.ml | 55 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 799d7ce..05a8f03 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -15,7 +15,60 @@ type t = { mutable pushed : pushed_token list; } -let create html = { scanner = Ragel_html_tokenizer.create html; pushed = [] } +let valid_utf_8 html = + let length = String.length html in + let byte index = Char.code (String.unsafe_get html index) in + let rec continuations index count = + if count = 0 then run index + else if index < length && byte index land 0xC0 = 0x80 then + continuations (index + 1) (count - 1) + else false + and run index = + if index >= length then true + else + let first = byte index in + if first < 0x80 then run (index + 1) + else if first < 0xC2 then false + else if first < 0xE0 then continuations (index + 1) 1 + else if first < 0xF0 then + if index + 1 >= length then false + else + let second = byte (index + 1) in + let low, high = + if first = 0xE0 then (0xA0, 0xBF) + else if first = 0xED then (0x80, 0x9F) + else (0x80, 0xBF) + in + if second >= low && second <= high then continuations (index + 2) 1 + else false + else if first < 0xF5 then + if index + 1 >= length then false + else + let second = byte (index + 1) in + let low, high = + if first = 0xF0 then (0x90, 0xBF) + else if first = 0xF4 then (0x80, 0x8F) + else (0x80, 0xBF) + in + if second >= low && second <= high then continuations (index + 2) 2 + else false + else false + in + run 0 + +let replace_malformed html = + let buffer = Buffer.create (String.length html + 16) in + Uutf.String.fold_utf_8 + (fun () _ -> function + | `Uchar uchar -> Uutf.Buffer.add_utf_8 buffer uchar + | `Malformed _ -> Uutf.Buffer.add_utf_8 buffer Uutf.u_rep) + () html; + Buffer.contents buffer + +let create html = + let html = if valid_utf_8 html then html else replace_malformed html in + { scanner = Ragel_html_tokenizer.create html; pushed = [] } + let location () = { line = 1; column = -1 } let next source state (out : location_out) = From d00798cf0d570e94d54d0fa70ac4dafd3997eabd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 16:51:12 +0000 Subject: [PATCH 046/109] use uutf to validate utf8 input --- src/lite/token_source.ml | 47 +++++----------------------------------- 1 file changed, 6 insertions(+), 41 deletions(-) diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 05a8f03..8ff9c7e 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -1,8 +1,6 @@ (* This file is part of Markup.ml, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) -open Common - type location_out = Ragel_html_tokenizer.location_out = { mutable line : int; mutable column : int; @@ -16,45 +14,12 @@ type t = { } let valid_utf_8 html = - let length = String.length html in - let byte index = Char.code (String.unsafe_get html index) in - let rec continuations index count = - if count = 0 then run index - else if index < length && byte index land 0xC0 = 0x80 then - continuations (index + 1) (count - 1) - else false - and run index = - if index >= length then true - else - let first = byte index in - if first < 0x80 then run (index + 1) - else if first < 0xC2 then false - else if first < 0xE0 then continuations (index + 1) 1 - else if first < 0xF0 then - if index + 1 >= length then false - else - let second = byte (index + 1) in - let low, high = - if first = 0xE0 then (0xA0, 0xBF) - else if first = 0xED then (0x80, 0x9F) - else (0x80, 0xBF) - in - if second >= low && second <= high then continuations (index + 2) 1 - else false - else if first < 0xF5 then - if index + 1 >= length then false - else - let second = byte (index + 1) in - let low, high = - if first = 0xF0 then (0x90, 0xBF) - else if first = 0xF4 then (0x80, 0x8F) - else (0x80, 0xBF) - in - if second >= low && second <= high then continuations (index + 2) 2 - else false - else false - in - run 0 + try + Uutf.String.fold_utf_8 + (fun () _ -> function `Uchar _ -> () | `Malformed _ -> raise Exit) + () html; + true + with Exit -> false let replace_malformed html = let buffer = Buffer.create (String.length html + 16) in From aeb55b93acfed693f0f46d9638f7e3d8ba0fba60 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 16:51:12 +0000 Subject: [PATCH 047/109] fix: emit
end tags like src/baseline --- src/lite/ragel_html_tokenizer.ml | 8809 ++++++++++++++++++++------- src/lite/ragel_html_tokenizer.ml.rl | 8 +- 2 files changed, 6538 insertions(+), 2279 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 1cdc8ed..c1a0e9c 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -1,6 +1,6 @@ -(* Derived from Devkit's htmlStream_ragel.ml.rl. -Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. -The original source is available from https://github.com/ygrek/ocaml-webstack. *) +(* Derived from Devkit htmlStream_ragel.ml.rl. + Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. + The original source is available from https://github.com/ygrek/ocaml-webstack. *) [@@@ocaml.warning "-38-32"] @@ -48,2013 +48,6256 @@ let emit scanner token = let emit_many scanner tokens = List.iter (emit scanner) tokens let _htmlstream_trans_keys : int array = - [| - 1; - 10; - 1; - 10; - 0; - 22; - 1; - 1; - 1; - 22; - 1; - 6; - 1; - 6; - 1; - 6; - 1; - 12; - 1; - 22; - 0; - 22; - 0; - 22; - 0; - 22; - 0; - 22; - 0; - 12; - 0; - 12; - 1; - 10; - 1; - 3; - 1; - 3; - 0; - 22; - 1; - 12; - 1; - 5; - 1; - 5; - 0; - 22; - 0; - 22; - 0; - 22; - 0; - 22; - 0; - 12; - 1; - 10; - 0; - 12; - 0; - 12; - 1; - 10; - 1; - 3; - 1; - 3; - 0; - 22; - 1; - 5; - 1; - 5; - 0; - 22; - 1; - 12; - 1; - 22; - 1; - 22; - 1; - 10; - 1; - 10; - 0; - 10; - 0; - 20; - 1; - 14; - 1; - 19; - 1; - 16; - 1; - 18; - 1; - 21; - 0; - 12; - 1; - 1; - 1; - 10; - 1; - 10; - 0; - 10; - 0; - 20; - 1; - 21; - 1; - 22; - 1; - 17; - 1; - 15; - 0; - 12; - 1; - 1; - 1; - 10; - 1; - 10; - 0; - 10; - 0; - 21; - 1; - 16; - 1; - 21; - 1; - 17; - 1; - 15; - 0; - 12; - 1; - 1; - 1; - 12; - 1; - 1; - 0; - |] + Array.concat + [ + [| + 10; + 60; + 10; + 60; + 0; + 122; + 10; + 10; + 10; + 122; + 10; + 45; + 10; + 45; + 10; + 45; + 10; + 62; + 10; + 122; + 0; + 122; + 0; + 122; + 0; + 122; + 0; + 122; + 0; + 62; + 0; + 62; + 10; + 60; + 10; + 34; + 10; + 34; + 0; + 122; + 10; + 62; + 10; + 39; + 10; + 39; + 0; + 122; + 0; + 122; + 0; + 122; + 0; + 122; + 0; + 62; + 10; + 60; + 0; + 62; + 0; + 62; + 10; + 60; + 10; + 34; + 10; + 34; + 0; + 122; + 10; + 39; + 10; + 39; + 0; + 122; + 10; + 62; + 10; + 122; + 10; + 122; + 10; + 60; + 10; + 60; + 0; + 60; + 0; + 115; + 10; + 99; + 10; + 114; + 10; + 105; + 10; + 112; + 10; + 116; + 0; + 62; + 10; + 10; + 10; + 60; + 10; + 60; + 0; + 60; + 0; + 115; + 10; + 116; + 10; + 121; + 10; + 108; + 10; + 101; + 0; + 62; + 10; + 10; + 10; + 60; + 10; + 60; + 0; + 60; + 0; + 116; + 10; + 105; + 10; + 116; + 10; + 108; + 10; + 101; + 0; + 62; + 10; + 10; + 10; + 62; + 10; + 10; + 0; + |]; + ] -let _htmlstream_char_class : int array = - [| - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 1; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 2; - 3; - 4; - 4; - 4; - 4; - 5; - 4; - 4; - 4; - 4; - 4; - 6; - 7; - 8; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 7; - 4; - 10; - 11; - 12; - 13; - 4; - 9; - 9; - 14; - 9; - 15; - 9; - 9; - 9; - 16; - 9; - 9; - 17; - 9; - 9; - 9; - 18; - 9; - 19; - 20; - 21; - 9; - 9; - 9; - 9; - 22; - 9; - 4; - 4; - 4; - 4; - 7; - 4; - 9; - 9; - 14; - 9; - 15; - 9; - 9; - 9; - 16; - 9; - 9; - 17; - 9; - 9; - 9; - 18; - 9; - 19; - 20; - 21; - 9; - 9; - 9; - 9; - 22; - 9; - 0; - |] +let _htmlstream_key_spans : int array = + Array.concat + [ + [| + 51; + 51; + 123; + 1; + 113; + 36; + 36; + 36; + 53; + 113; + 123; + 123; + 123; + 123; + 63; + 63; + 51; + 25; + 25; + 123; + 53; + 30; + 30; + 123; + 123; + 123; + 123; + 63; + 51; + 63; + 63; + 51; + 25; + 25; + 123; + 30; + 30; + 123; + 53; + 113; + 113; + 51; + 51; + 61; + 116; + 90; + 105; + 96; + 103; + 107; + 63; + 1; + 51; + 51; + 61; + 116; + 107; + 112; + 99; + 92; + 63; + 1; + 51; + 51; + 61; + 117; + 96; + 107; + 99; + 92; + 63; + 1; + 53; + 1; + |]; + ] let _htmlstream_index_offsets : int array = - [| - 0; - 10; - 20; - 43; - 44; - 66; - 72; - 78; - 84; - 96; - 118; - 141; - 164; - 187; - 210; - 223; - 236; - 246; - 249; - 252; - 275; - 287; - 292; - 297; - 320; - 343; - 366; - 389; - 402; - 412; - 425; - 438; - 448; - 451; - 454; - 477; - 482; - 487; - 510; - 522; - 544; - 566; - 576; - 586; - 597; - 618; - 632; - 651; - 667; - 685; - 706; - 719; - 720; - 730; - 740; - 751; - 772; - 793; - 815; - 832; - 847; - 860; - 861; - 871; - 881; - 892; - 914; - 930; - 951; - 968; - 983; - 996; - 997; - 1009; - 0; - |] + Array.concat + [ + [| + 0; + 52; + 104; + 228; + 230; + 344; + 381; + 418; + 455; + 509; + 623; + 747; + 871; + 995; + 1119; + 1183; + 1247; + 1299; + 1325; + 1351; + 1475; + 1529; + 1560; + 1591; + 1715; + 1839; + 1963; + 2087; + 2151; + 2203; + 2267; + 2331; + 2383; + 2409; + 2435; + 2559; + 2590; + 2621; + 2745; + 2799; + 2913; + 3027; + 3079; + 3131; + 3193; + 3310; + 3401; + 3507; + 3604; + 3708; + 3816; + 3880; + 3882; + 3934; + 3986; + 4048; + 4165; + 4273; + 4386; + 4486; + 4579; + 4643; + 4645; + 4697; + 4749; + 4811; + 4929; + 5026; + 5134; + 5234; + 5327; + 5391; + 5393; + 5447; + |]; + ] -let _htmlstream_indices : int array = - [| - 2; - 1; - 1; - 1; - 1; - 1; - 1; - 1; - 1; - 3; - 6; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 7; - 3; - 10; - 11; - 9; - 9; - 9; - 12; - 12; - 13; - 12; - 9; - 9; - 9; - 14; - 12; - 12; - 12; - 12; - 12; - 12; - 12; - 12; - 12; - 16; - 18; - 9; - 9; - 9; - 9; - 19; - 9; - 9; - 20; - 9; - 9; - 9; - 9; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 18; - 9; - 9; - 9; - 9; - 22; - 24; - 22; - 22; - 22; - 22; - 25; - 24; - 22; - 22; - 22; - 22; - 27; - 24; - 22; - 22; - 22; - 22; - 27; - 22; - 22; - 22; - 22; - 22; - 0; - 18; - 9; - 9; - 9; - 9; - 30; - 30; - 9; - 30; - 9; - 9; - 9; - 9; - 30; - 30; - 30; - 30; - 30; - 30; - 30; - 30; - 30; - 32; - 33; - 9; - 9; - 9; - 9; - 30; - 30; - 9; - 30; - 9; - 9; - 34; - 35; - 30; - 30; - 30; - 30; - 30; - 30; - 30; - 30; - 30; - 37; - 38; - 9; - 9; - 9; - 9; - 39; - 39; - 9; - 39; - 9; - 9; - 40; - 41; - 39; - 39; - 39; - 39; - 39; - 39; - 39; - 39; - 39; - 43; - 44; - 9; - 9; - 9; - 9; - 45; - 45; - 9; - 45; - 9; - 46; - 47; - 48; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 50; - 51; - 9; - 9; - 9; - 9; - 52; - 52; - 9; - 52; - 9; - 53; - 54; - 55; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 53; - 58; - 57; - 59; - 57; - 60; - 57; - 57; - 57; - 57; - 57; - 57; - 9; - 63; - 64; - 62; - 9; - 62; - 9; - 62; - 62; - 62; - 62; - 62; - 62; - 65; - 68; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 69; - 72; - 71; - 73; - 76; - 75; - 77; - 79; - 80; - 9; - 9; - 9; - 9; - 52; - 52; - 9; - 52; - 9; - 9; - 54; - 55; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 18; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 40; - 84; - 83; - 83; - 83; - 73; - 87; - 86; - 86; - 86; - 77; - 89; - 90; - 9; - 9; - 9; - 9; - 91; - 91; - 92; - 91; - 9; - 9; - 93; - 9; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 95; - 96; - 9; - 9; - 9; - 9; - 97; - 97; - 98; - 97; - 9; - 9; - 99; - 9; - 97; - 97; - 97; - 97; - 97; - 97; - 97; - 97; - 97; - 101; - 102; - 9; - 9; - 9; - 9; - 103; - 103; - 104; - 103; - 9; - 105; - 106; - 9; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 108; - 109; - 9; - 9; - 9; - 9; - 110; - 110; - 111; - 110; - 9; - 112; - 113; - 9; - 110; - 110; - 110; - 110; - 110; - 110; - 110; - 110; - 110; - 98; - 115; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 116; - 119; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 120; - 112; - 123; - 122; - 124; - 122; - 125; - 122; - 122; - 122; - 122; - 122; - 122; - 9; - 128; - 129; - 127; - 9; - 127; - 9; - 127; - 127; - 127; - 127; - 127; - 127; - 130; - 133; - 132; - 132; - 132; - 132; - 132; - 132; - 132; - 132; - 134; - 137; - 136; - 138; - 141; - 140; - 142; - 144; - 145; - 9; - 9; - 9; - 9; - 110; - 110; - 111; - 110; - 9; - 9; - 113; - 9; - 110; - 110; - 110; - 110; - 110; - 110; - 110; - 110; - 110; - 148; - 147; - 147; - 147; - 138; - 151; - 150; - 150; - 150; - 142; - 154; - 155; - 153; - 153; - 153; - 153; - 156; - 156; - 153; - 156; - 153; - 153; - 157; - 153; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 160; - 159; - 159; - 159; - 159; - 159; - 159; - 159; - 159; - 159; - 159; - 0; - 163; - 162; - 162; - 162; - 162; - 164; - 164; - 162; - 164; - 162; - 162; - 165; - 162; - 164; - 164; - 164; - 164; - 164; - 164; - 164; - 164; - 164; - 18; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 20; - 9; - 9; - 9; - 9; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 169; - 168; - 168; - 168; - 168; - 168; - 168; - 168; - 168; - 170; - 172; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 174; - 175; - 171; - 171; - 171; - 171; - 171; - 171; - 176; - 171; - 173; - 176; - 177; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 178; - 172; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 171; - 171; - 179; - 172; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 180; - 172; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 171; - 171; - 171; - 171; - 181; - 172; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 182; - 172; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 183; - 183; - 184; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 173; - 171; - 185; - 187; - 190; - 189; - 189; - 189; - 189; - 189; - 189; - 189; - 189; - 191; - 193; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 195; - 196; - 192; - 192; - 192; - 192; - 192; - 192; - 197; - 192; - 194; - 197; - 198; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 199; - 193; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 200; - 193; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 201; - 193; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 192; - 192; - 192; - 192; - 192; - 192; - 202; - 193; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 192; - 192; - 192; - 192; - 203; - 203; - 204; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 194; - 192; - 205; - 207; - 210; - 209; - 209; - 209; - 209; - 209; - 209; - 209; - 209; - 211; - 213; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 215; - 216; - 212; - 212; - 212; - 212; - 212; - 212; - 217; - 212; - 214; - 217; - 218; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 219; - 213; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 212; - 212; - 212; - 212; - 212; - 220; - 213; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 221; - 213; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 212; - 212; - 212; - 212; - 212; - 212; - 222; - 213; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 212; - 212; - 212; - 212; - 223; - 223; - 224; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 214; - 212; - 225; - 227; - 229; - 228; - 228; - 228; - 228; - 228; - 228; - 228; - 228; - 228; - 228; - 230; - 232; - 0; - |] +let _htmlstream_indicies : int array = + Array.concat + [ + [| + 1; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 2; + 0; + 4; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 5; + 3; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 7; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 2; + 8; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 9; + 9; + 10; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 6; + 6; + 6; + 6; + 11; + 6; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 6; + 6; + 6; + 6; + 9; + 6; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 9; + 6; + 13; + 12; + 14; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 15; + 6; + 6; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 6; + 6; + 6; + 6; + 6; + 6; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 6; + 14; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 17; + 6; + 18; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 19; + 17; + 18; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 20; + 17; + 18; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 20; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 17; + 21; + 17; + 14; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 22; + 22; + 6; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 6; + 6; + 6; + 6; + 6; + 6; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 6; + 6; + 6; + 6; + 22; + 6; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 6; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 24; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 22; + 22; + 6; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 6; + 6; + 6; + 25; + 26; + 6; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 6; + 6; + 6; + 6; + 22; + 6; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 22; + 6; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 28; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 29; + 29; + 6; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 6; + 6; + 6; + 30; + 31; + 6; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 6; + 6; + 6; + 6; + 29; + 6; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 6; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 33; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 32; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 34; + 34; + 6; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 6; + 6; + 35; + 36; + 37; + 6; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 6; + 6; + 6; + 6; + 34; + 6; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 34; + 6; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 39; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 38; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 40; + 40; + 6; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 6; + 6; + 41; + 42; + 43; + 6; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 6; + 6; + 6; + 6; + 40; + 6; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 6; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 45; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 41; + 44; + 46; + 44; + 44; + 44; + 44; + 47; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 6; + 44; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 50; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 49; + 48; + 6; + 48; + 48; + 48; + 48; + 6; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 51; + 48; + 53; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 52; + 54; + 52; + 56; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 55; + 57; + 55; + 59; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 58; + 60; + 58; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 62; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 61; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 40; + 40; + 6; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 6; + 6; + 6; + 42; + 43; + 6; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 6; + 6; + 6; + 6; + 40; + 6; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 6; + 14; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 30; + 6; + 64; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 57; + 63; + 66; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 65; + 60; + 65; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 68; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 67; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 69; + 69; + 70; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 6; + 6; + 6; + 71; + 6; + 6; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 6; + 6; + 6; + 6; + 69; + 6; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 69; + 6; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 73; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 72; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 74; + 74; + 75; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 6; + 6; + 6; + 76; + 6; + 6; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 6; + 6; + 6; + 6; + 74; + 6; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 74; + 6; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 78; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 77; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 79; + 79; + 80; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 6; + 6; + 81; + 82; + 6; + 6; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 6; + 6; + 6; + 6; + 79; + 6; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 79; + 6; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 84; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 83; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 85; + 85; + 86; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 6; + 6; + 87; + 88; + 6; + 6; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 6; + 6; + 6; + 6; + 85; + 6; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 6; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 89; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 90; + 6; + 92; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 91; + 93; + 91; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 95; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 87; + 94; + 96; + 94; + 94; + 94; + 94; + 97; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 94; + 6; + 94; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 100; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 99; + 98; + 6; + 98; + 98; + 98; + 98; + 6; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 101; + 98; + 103; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 102; + 104; + 102; + 106; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 105; + 107; + 105; + 109; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 108; + 110; + 108; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 112; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 111; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 85; + 85; + 86; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 6; + 6; + 6; + 88; + 6; + 6; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 6; + 6; + 6; + 6; + 85; + 6; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 85; + 6; + 114; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 113; + 107; + 113; + 116; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 115; + 110; + 115; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 119; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 118; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 120; + 120; + 117; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 117; + 117; + 117; + 121; + 117; + 117; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 117; + 117; + 117; + 117; + 120; + 117; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 117; + 123; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 21; + 122; + 125; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 124; + 126; + 126; + 124; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 124; + 124; + 124; + 127; + 124; + 124; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 124; + 124; + 124; + 124; + 126; + 124; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 126; + 124; + 14; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 6; + 6; + 6; + 6; + 6; + 6; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 6; + 129; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 130; + 128; + 132; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 135; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 134; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 136; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 137; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 136; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 138; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 138; + 131; + 132; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 131; + 131; + 131; + 131; + 131; + 139; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 139; + 131; + 132; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 140; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 140; + 131; + 132; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 141; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 141; + 131; + 132; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 142; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 142; + 131; + 132; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 143; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 143; + 131; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 144; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 143; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 131; + 133; + 131; + 145; + 131; + 147; + 146; + 149; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 148; + 150; + 148; + 152; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 155; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 154; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 156; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 157; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 156; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 158; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 158; + 151; + 152; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 159; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 159; + 151; + 152; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 160; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 160; + 151; + 152; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 161; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 161; + 151; + 152; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 162; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 162; + 151; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 163; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 162; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 151; + 153; + 151; + 164; + 151; + 166; + 165; + 168; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 167; + 169; + 167; + 171; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 174; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 173; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 175; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 176; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 175; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 177; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 177; + 170; + 171; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 178; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 178; + 170; + 171; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 179; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 179; + 170; + 171; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 180; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 180; + 170; + 171; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 181; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 181; + 170; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 182; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 181; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 170; + 172; + 170; + 183; + 170; + 185; + 184; + 187; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 186; + 188; + 186; + 190; + 189; + 0; + |]; + ] -let _htmlstream_index_defaults : int array = - [| - 1; - 5; - 9; - 15; - 9; - 9; - 22; - 22; - 22; - 9; - 9; - 9; - 9; - 9; - 57; - 62; - 67; - 71; - 75; - 9; - 9; - 83; - 86; - 9; - 9; - 9; - 9; - 9; - 118; - 122; - 127; - 132; - 136; - 140; - 9; - 147; - 150; - 153; - 159; - 162; - 9; - 168; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 171; - 186; - 189; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 192; - 206; - 209; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 212; - 226; - 228; - 231; - 0; - |] +let _htmlstream_trans_targs : int array = + Array.concat + [ + [| + 1; + 1; + 2; + 1; + 1; + 2; + 3; + 2; + 4; + 23; + 37; + 40; + 3; + 3; + 3; + 5; + 9; + 6; + 6; + 7; + 8; + 0; + 10; + 11; + 11; + 16; + 20; + 11; + 11; + 12; + 16; + 20; + 13; + 13; + 12; + 14; + 16; + 20; + 13; + 13; + 12; + 14; + 16; + 20; + 15; + 14; + 17; + 21; + 15; + 11; + 11; + 16; + 1; + 1; + 2; + 18; + 18; + 19; + 18; + 18; + 19; + 11; + 11; + 22; + 22; + 22; + 22; + 24; + 24; + 23; + 27; + 31; + 24; + 24; + 25; + 27; + 31; + 26; + 26; + 25; + 27; + 29; + 31; + 26; + 26; + 25; + 27; + 29; + 31; + 27; + 28; + 1; + 1; + 2; + 30; + 29; + 32; + 35; + 30; + 24; + 24; + 31; + 1; + 1; + 2; + 33; + 33; + 34; + 33; + 33; + 34; + 24; + 24; + 36; + 36; + 36; + 36; + 38; + 37; + 37; + 39; + 0; + 38; + 38; + 38; + 38; + 39; + 0; + 42; + 42; + 43; + 42; + 42; + 43; + 43; + 43; + 44; + 44; + 45; + 46; + 47; + 48; + 49; + 50; + 50; + 51; + 51; + 51; + 53; + 53; + 54; + 53; + 53; + 54; + 54; + 54; + 55; + 55; + 56; + 57; + 58; + 59; + 60; + 60; + 61; + 61; + 61; + 63; + 63; + 64; + 63; + 63; + 64; + 64; + 64; + 65; + 65; + 66; + 67; + 68; + 69; + 70; + 70; + 71; + 71; + 71; + 72; + 72; + 73; + 73; + 73; + |]; + ] -let _htmlstream_cond_targs : int array = - [| - 0; - 1; - 1; - 2; - 1; - 1; - 1; - 2; - 2; - 3; - 2; - 4; - 23; - 37; - 40; - 3; - 3; - 4; - 3; - 5; - 9; - 5; - 6; - 6; - 6; - 7; - 7; - 8; - 8; - 9; - 10; - 10; - 11; - 11; - 16; - 20; - 11; - 11; - 11; - 12; - 16; - 20; - 12; - 13; - 13; - 12; - 14; - 16; - 20; - 13; - 13; - 13; - 12; - 14; - 16; - 20; - 14; - 15; - 14; - 17; - 21; - 15; - 15; - 11; - 11; - 16; - 16; - 1; - 1; - 2; - 17; - 18; - 18; - 19; - 18; - 18; - 18; - 19; - 19; - 11; - 11; - 20; - 21; - 22; - 22; - 22; - 22; - 22; - 23; - 24; - 24; - 23; - 27; - 31; - 24; - 24; - 24; - 25; - 27; - 31; - 25; - 26; - 26; - 25; - 27; - 29; - 31; - 26; - 26; - 26; - 25; - 27; - 29; - 31; - 27; - 27; - 28; - 28; - 1; - 1; - 2; - 29; - 30; - 29; - 32; - 35; - 30; - 30; - 24; - 24; - 31; - 31; - 1; - 1; - 2; - 32; - 33; - 33; - 34; - 33; - 33; - 33; - 34; - 34; - 24; - 24; - 35; - 36; - 36; - 36; - 36; - 36; - 37; - 38; - 37; - 37; - 39; - 0; - 38; - 38; - 38; - 39; - 38; - 38; - 39; - 0; - 40; - 41; - 42; - 42; - 43; - 42; - 42; - 43; - 43; - 43; - 44; - 44; - 45; - 46; - 47; - 48; - 49; - 50; - 50; - 51; - 51; - 51; - 52; - 53; - 53; - 54; - 53; - 53; - 54; - 54; - 54; - 55; - 55; - 56; - 57; - 58; - 59; - 60; - 60; - 61; - 61; - 61; - 62; - 63; - 63; - 64; - 63; - 63; - 64; - 64; - 64; - 65; - 65; - 66; - 67; - 68; - 69; - 70; - 70; - 71; - 71; - 71; - 72; - 72; - 73; - 73; - 73; - 0; - |] +let _htmlstream_trans_actions : int array = + Array.concat + [ + [| + 1; + 2; + 0; + 0; + 4; + 3; + 5; + 4; + 6; + 7; + 6; + 6; + 0; + 4; + 8; + 0; + 1; + 0; + 4; + 0; + 0; + 0; + 0; + 9; + 10; + 9; + 9; + 0; + 4; + 1; + 0; + 0; + 11; + 12; + 0; + 11; + 13; + 13; + 0; + 4; + 14; + 0; + 15; + 15; + 1; + 4; + 0; + 0; + 0; + 16; + 17; + 16; + 19; + 20; + 18; + 1; + 2; + 21; + 0; + 4; + 22; + 15; + 23; + 1; + 2; + 0; + 4; + 24; + 25; + 0; + 24; + 24; + 0; + 4; + 1; + 0; + 0; + 11; + 12; + 0; + 13; + 11; + 13; + 0; + 4; + 14; + 15; + 0; + 15; + 4; + 0; + 27; + 28; + 26; + 1; + 4; + 0; + 0; + 0; + 16; + 17; + 16; + 30; + 31; + 29; + 1; + 2; + 21; + 0; + 4; + 22; + 15; + 23; + 1; + 2; + 0; + 4; + 32; + 0; + 4; + 1; + 32; + 0; + 4; + 33; + 34; + 0; + 33; + 1; + 35; + 21; + 0; + 4; + 22; + 0; + 4; + 0; + 4; + 0; + 0; + 0; + 0; + 0; + 0; + 4; + 36; + 0; + 4; + 1; + 35; + 21; + 0; + 4; + 22; + 0; + 4; + 0; + 4; + 0; + 0; + 0; + 0; + 0; + 4; + 37; + 0; + 4; + 1; + 35; + 21; + 0; + 4; + 22; + 0; + 4; + 0; + 4; + 0; + 0; + 0; + 0; + 0; + 4; + 38; + 0; + 4; + 0; + 4; + 39; + 0; + 4; + |]; + ] -let _htmlstream_cond_actions : int array = - [| - 0; - 1; - 2; - 0; - 3; - 0; - 4; - 3; - 5; - 5; - 4; - 6; - 7; - 6; - 6; - 0; - 4; - 5; - 8; - 0; - 1; - 5; - 0; - 5; - 4; - 0; - 5; - 0; - 5; - 5; - 0; - 5; - 9; - 10; - 9; - 9; - 5; - 0; - 4; - 1; - 0; - 0; - 5; - 11; - 12; - 0; - 11; - 13; - 13; - 5; - 0; - 4; - 14; - 0; - 15; - 15; - 5; - 1; - 4; - 0; - 0; - 5; - 0; - 16; - 17; - 16; - 18; - 19; - 20; - 18; - 5; - 1; - 2; - 21; - 5; - 0; - 4; - 22; - 5; - 15; - 23; - 5; - 5; - 1; - 2; - 5; - 0; - 4; - 5; - 24; - 25; - 0; - 24; - 24; - 5; - 0; - 4; - 1; - 0; - 0; - 5; - 11; - 12; - 0; - 13; - 11; - 13; - 5; - 0; - 4; - 14; - 15; - 0; - 15; - 5; - 4; - 0; - 26; - 27; - 28; - 26; - 5; - 1; - 4; - 0; - 0; - 5; - 0; - 16; - 17; - 16; - 29; - 30; - 31; - 29; - 5; - 1; - 2; - 21; - 5; - 0; - 4; - 22; - 5; - 15; - 23; - 5; - 1; - 2; - 5; - 0; - 4; - 5; - 32; - 0; - 4; - 1; - 32; - 5; - 0; - 4; - 5; - 33; - 34; - 0; - 33; - 5; - 0; - 1; - 35; - 21; - 0; - 4; - 22; - 0; - 4; - 0; - 4; - 0; - 0; - 0; - 0; - 0; - 0; - 4; - 36; - 0; - 4; - 0; - 1; - 35; - 21; - 0; - 4; - 22; - 0; - 4; - 0; - 4; - 0; - 0; - 0; - 0; - 0; - 4; - 37; - 0; - 4; - 0; - 1; - 35; - 21; - 0; - 4; - 22; - 0; - 4; - 0; - 4; - 0; - 0; - 0; - 0; - 0; - 4; - 38; - 0; - 4; - 0; - 4; - 39; - 0; - 4; - 0; - |] - -let _htmlstream_eof_trans : int array = - [| - 1; - 5; - 9; - 16; - 18; - 22; - 24; - 27; - 29; - 30; - 32; - 37; - 43; - 50; - 57; - 62; - 67; - 71; - 75; - 79; - 82; - 83; - 86; - 89; - 95; - 101; - 108; - 115; - 118; - 122; - 127; - 132; - 136; - 140; - 144; - 147; - 150; - 153; - 159; - 162; - 167; - 168; - 172; - 175; - 177; - 179; - 180; - 181; - 182; - 183; - 184; - 187; - 189; - 193; - 196; - 198; - 200; - 201; - 202; - 203; - 204; - 207; - 209; - 213; - 216; - 218; - 220; - 221; - 222; - 223; - 224; - 227; - 229; - 232; - 0; - |] +let _htmlstream_eof_actions : int array = + Array.concat + [ + [| + 0; + 3; + 5; + 0; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 18; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 26; + 5; + 5; + 29; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 5; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + |]; + ] let htmlstream_start : int = 0 let htmlstream_first_final : int = 0 @@ -2065,11 +6308,19 @@ let htmlstream_en_in_title : int = 62 let htmlstream_en_garbage_tag : int = 72 let htmlstream_en_main : int = 0 +type _htmlstream_state = { mutable keys : int; mutable trans : int } + +exception Goto_match_htmlstream +exception Goto_again_htmlstream +exception Goto_eof_trans_htmlstream + let create data = let cs = ref 0 in + begin - cs := htmlstream_start + cs.contents <- htmlstream_start end; + let length = String.length data in { data; @@ -2119,320 +6370,288 @@ let run scanner = mark_end := -1; text in + begin - let _trans : int ref = ref 0 in - let _keys : int ref = ref 0 in - let _inds : int ref = ref 0 in - let _ic : int ref = ref 0 in - let _have : int ref = ref 0 in - let _cont : int ref = ref 1 in - let _again : int ref = ref 1 in - let _bsc : int ref = ref 1 in - while - _again.contents = 1 - && (p.contents != pe.contents || p.contents = eof.contents) - do - begin - _cont := 1; - _again := 1; - if p.contents = eof.contents then begin - begin if _htmlstream_eof_trans.(cs.contents) > 0 then begin begin - _trans := _htmlstream_eof_trans.(cs.contents) - 1 - end - end - end - end - else begin begin - _keys := cs.contents lsl 1; - _inds := _htmlstream_index_offsets.(cs.contents); - if - Char.code data.[p.contents] <= 122 - && Char.code data.[p.contents] >= 0 - then begin begin - _ic := _htmlstream_char_class.(Char.code data.[p.contents] - 0); - if - _ic.contents <= _htmlstream_trans_keys.(_keys.contents + 1) - && _ic.contents >= _htmlstream_trans_keys.(_keys.contents) - then begin - _trans := - _htmlstream_indices.(_inds.contents - + (_ic.contents - - _htmlstream_trans_keys.(_keys - .contents) - )) - end - else begin - _trans := _htmlstream_index_defaults.(cs.contents) - end - end - end - else begin begin - _trans := _htmlstream_index_defaults.(cs.contents) - end - end - end - end; - cs := _htmlstream_cond_targs.(_trans.contents); - if _htmlstream_cond_actions.(_trans.contents) != 0 then begin - begin if _htmlstream_cond_actions.(_trans.contents) = 1 then begin + let state = { keys = 0; trans = 0 } in + let rec do_start () = + if p.contents = pe.contents then do_test_eof () else do_resume () + and do_resume () = + begin try + let keys = cs.contents lsl 1 in + let inds = _htmlstream_index_offsets.(cs.contents) in + + let slen = _htmlstream_key_spans.(cs.contents) in + state.trans <- + _htmlstream_indicies.(inds + + + if + slen > 0 + && _htmlstream_trans_keys.(keys) + <= Char.code data.[p.contents] + && Char.code data.[p.contents] + <= _htmlstream_trans_keys.(keys + 1) + then + Char.code data.[p.contents] + - _htmlstream_trans_keys.(keys) + else slen) + with Goto_match_htmlstream -> () + end; + do_eof_trans () + and do_eof_trans () = + cs.contents <- _htmlstream_trans_targs.(state.trans); + + begin try + if _htmlstream_trans_actions.(state.trans) = 0 then + raise_notrace Goto_again_htmlstream; + + match _htmlstream_trans_actions.(state.trans) with + | 1 -> begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 22 then begin + end; + () + | 22 -> begin mark_end := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 24 then begin + end; + () + | 24 -> begin tag := String.lowercase_ascii @@ sub (); attrs := [] - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 33 then begin + end; + () + | 33 -> begin let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (End (make_tag name [])); - pause () - end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 9 then begin + emit scanner (End (make_tag name [])); + pause () + end; + () + | 9 -> begin directive := String.lowercase_ascii @@ sub (); attrs := [] - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 3 then begin + end; + () + | 3 -> begin emit scanner (String (decode (sub ()))); pause () - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 11 then begin + end; + () + | 11 -> begin key := String.lowercase_ascii @@ sub () - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 15 then begin + end; + () + | 15 -> begin attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 29 then begin + end; + () + | 29 -> begin match !tag with | "script" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 41 + cs.contents <- 41; + if true then raise_notrace Goto_again_htmlstream end | "style" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 52 + cs.contents <- 52; + if true then raise_notrace Goto_again_htmlstream end | "title" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 62 + cs.contents <- 62; + if true then raise_notrace Goto_again_htmlstream end | "" -> () | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause () - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 26 then begin + end; + () + | 26 -> begin let start = Start (make_tag !tag (attributes !attrs)) in if !tag = "a" || !tag = "br" then emit scanner start else emit_many scanner [ start; End (make_tag !tag []) ]; pause () - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 39 then begin + end; + () + | 39 -> begin match !tag with | "script" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 41 + cs.contents <- 41; + if true then raise_notrace Goto_again_htmlstream end | "style" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 52 + cs.contents <- 52; + if true then raise_notrace Goto_again_htmlstream end | "title" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 62 + cs.contents <- 62; + if true then raise_notrace Goto_again_htmlstream end - | "" -> begin cs := 0 end + | "" -> begin + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream + end | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause (); begin - cs := 0 + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 18 then begin - begin end - end - else if _htmlstream_cond_actions.(_trans.contents) = 5 then begin + end; + () + | 18 -> + begin end; + () + | 5 -> begin + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 72 + cs.contents <- 72; + if true then raise_notrace Goto_again_htmlstream end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 4 then begin + end; + () + | 4 -> begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 6 then begin + end; + () + | 6 -> begin tag := "" - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 21 then begin + end; + () + | 21 -> begin mark := !p end; begin mark_end := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 32 then begin + end; + () + | 32 -> begin mark := !p end; begin let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (End (make_tag name [])); - pause () - end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 2 then begin + emit scanner (End (make_tag name [])); + pause () + end; + () + | 2 -> begin mark := !p end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 16 then begin + end; + () + | 16 -> begin mark_end := !p end; begin attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 25 then begin + end; + () + | 25 -> begin tag := String.lowercase_ascii @@ sub (); attrs := [] end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 34 then begin + end; + () + | 34 -> begin let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (End (make_tag name [])); - pause () - end + emit scanner (End (make_tag name [])); + pause () end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 10 then begin + end; + () + | 10 -> begin directive := String.lowercase_ascii @@ sub (); attrs := [] end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 13 then begin + end; + () + | 13 -> begin key := String.lowercase_ascii @@ sub () end; begin attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 12 then begin + end; + () + | 12 -> begin key := String.lowercase_ascii @@ sub () end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 14 then begin + end; + () + | 14 -> begin attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs end; begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 23 then begin + end; + () + | 23 -> begin attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 30 then begin + end; + () + | 30 -> begin match !tag with | "script" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 41 + cs.contents <- 41; + if true then raise_notrace Goto_again_htmlstream end | "style" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 52 + cs.contents <- 52; + if true then raise_notrace Goto_again_htmlstream end | "title" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 62 + cs.contents <- 62; + if true then raise_notrace Goto_again_htmlstream end | "" -> () | name -> @@ -2441,9 +6660,9 @@ let run scanner = end; begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 27 then begin + end; + () + | 27 -> begin let start = Start (make_tag !tag (attributes !attrs)) in if !tag = "a" || !tag = "br" then emit scanner start @@ -2452,36 +6671,35 @@ let run scanner = end; begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 19 then begin + end; + () + | 19 -> begin end; begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 8 then begin + end; + () + | 8 -> begin + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 72 + cs.contents <- 72; + if true then raise_notrace Goto_again_htmlstream end end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 35 then begin + end; + () + | 35 -> begin scanner.line <- scanner.line + 1 end; begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 36 then begin + end; + () + | 36 -> begin emit_many scanner [ @@ -2493,11 +6711,12 @@ let run scanner = end; begin begin - cs := 0 + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 37 then begin + end; + () + | 37 -> begin emit_many scanner [ @@ -2509,11 +6728,12 @@ let run scanner = end; begin begin - cs := 0 + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 38 then begin + end; + () + | 38 -> begin emit_many scanner [ @@ -2525,19 +6745,20 @@ let run scanner = end; begin begin - cs := 0 + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream end - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 7 then begin + end; + () + | 7 -> begin tag := "" end; begin mark := !p - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 17 then begin + end; + () + | 17 -> begin mark_end := !p end; @@ -2546,30 +6767,27 @@ let run scanner = end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 31 then begin + end; + () + | 31 -> begin match !tag with | "script" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 41 + cs.contents <- 41; + if true then raise_notrace Goto_again_htmlstream end | "style" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 52 + cs.contents <- 52; + if true then raise_notrace Goto_again_htmlstream end | "title" -> + p.contents <- p.contents - 1; begin - p := p.contents - 1 - end; - begin - cs := 62 + cs.contents <- 62; + if true then raise_notrace Goto_again_htmlstream end | "" -> () | name -> @@ -2581,9 +6799,9 @@ let run scanner = end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 28 then begin + end; + () + | 28 -> begin let start = Start (make_tag !tag (attributes !attrs)) in if !tag = "a" || !tag = "br" then emit scanner start @@ -2595,48 +6813,91 @@ let run scanner = end; begin scanner.line <- scanner.line + 1 - end - end - else if _htmlstream_cond_actions.(_trans.contents) = 20 then begin + end; + () + | 20 -> begin end; begin mark := !p end; begin scanner.line <- scanner.line + 1 - end - end - end - end; - if _cont.contents = 1 then begin begin - if p.contents = eof.contents then begin - begin if cs.contents >= 0 then begin begin - _cont := 0; - _again := 0 - end - end - end - end - else begin begin - p := p.contents + 1; - begin - _cont := 0; - _again := 1 - end - end end; - if _cont.contents = 1 then begin begin + () + | _ -> () + with Goto_again_htmlstream -> () + end; + + do_again () + and do_again () = + p.contents <- p.contents + 1; + if p.contents <> pe.contents then do_resume () else do_test_eof () + and do_test_eof () = + if p.contents = eof.contents then + begin try + begin match _htmlstream_eof_actions.(cs.contents) with + | 3 -> + begin + emit scanner (String (decode (sub ()))); + pause () + end; + () + | 29 -> + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 41; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 52; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 62; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner (Start (make_tag name (attributes !attrs))); + pause () + end; + () + | 26 -> + begin + let start = Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; End (make_tag !tag []) ]; + pause () + end; + () + | 18 -> + begin end; + () + | 5 -> + begin + p.contents <- p.contents - 1; begin - _cont := 0; - _again := 0 + cs.contents <- 72; + if true then raise_notrace Goto_again_htmlstream end - end - end - end + end; + () + | _ -> () + end + with + | Goto_again_htmlstream -> do_again () + | Goto_eof_trans_htmlstream -> do_eof_trans () end - end - done + in + do_start () end; + if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 911a211..7d89554 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -1,4 +1,4 @@ -(* Derived from Devkit's htmlStream_ragel.ml.rl. +(* Derived from Devkit htmlStream_ragel.ml.rl. Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. The original source is available from https://github.com/ygrek/ocaml-webstack. *) @@ -60,10 +60,8 @@ let emit_many scanner tokens = action tag { tag := String.lowercase_ascii @@ sub (); attrs := []; } action close_tag { let name = String.lowercase_ascii @@ sub () in - if name <> "br" then begin - emit scanner (End (make_tag name [])); - pause () - end; + emit scanner (End (make_tag name [])); + pause (); } action directive { directive := String.lowercase_ascii @@ sub (); attrs := []; } action text { From 15e07889950717eac7868e59e6b24503f9985c83 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 16:53:15 +0000 Subject: [PATCH 048/109] fix: parse tag names with non-ident characters like src/baseline --- src/lite/ragel_html_tokenizer.ml | 364 ++++++++++------------------ src/lite/ragel_html_tokenizer.ml.rl | 5 +- 2 files changed, 130 insertions(+), 239 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index c1a0e9c..c686b40 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -98,7 +98,7 @@ let _htmlstream_trans_keys : int array = 10; 39; 0; - 122; + 62; 0; 122; 0; @@ -129,8 +129,8 @@ let _htmlstream_trans_keys : int array = 122; 10; 62; - 10; - 122; + 0; + 62; 10; 122; 10; @@ -230,7 +230,7 @@ let _htmlstream_key_spans : int array = 53; 30; 30; - 123; + 63; 123; 123; 123; @@ -246,7 +246,7 @@ let _htmlstream_key_spans : int array = 30; 123; 53; - 113; + 63; 113; 51; 51; @@ -312,56 +312,56 @@ let _htmlstream_index_offsets : int array = 1529; 1560; 1591; - 1715; - 1839; - 1963; - 2087; - 2151; - 2203; - 2267; - 2331; - 2383; - 2409; - 2435; - 2559; - 2590; - 2621; - 2745; - 2799; - 2913; - 3027; - 3079; - 3131; - 3193; - 3310; - 3401; - 3507; - 3604; - 3708; - 3816; - 3880; - 3882; - 3934; - 3986; - 4048; - 4165; - 4273; - 4386; - 4486; - 4579; - 4643; - 4645; - 4697; - 4749; - 4811; - 4929; - 5026; - 5134; - 5234; - 5327; - 5391; - 5393; - 5447; + 1655; + 1779; + 1903; + 2027; + 2091; + 2143; + 2207; + 2271; + 2323; + 2349; + 2375; + 2499; + 2530; + 2561; + 2685; + 2739; + 2803; + 2917; + 2969; + 3021; + 3083; + 3200; + 3291; + 3397; + 3494; + 3598; + 3706; + 3770; + 3772; + 3824; + 3876; + 3938; + 4055; + 4163; + 4276; + 4376; + 4469; + 4533; + 4535; + 4587; + 4639; + 4701; + 4819; + 4916; + 5024; + 5124; + 5217; + 5281; + 5283; + 5337; |]; ] @@ -1960,6 +1960,39 @@ let _htmlstream_indicies : int array = 65; 60; 65; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 69; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; 67; 67; 67; @@ -1970,15 +2003,11 @@ let _htmlstream_indicies : int array = 67; 67; 67; - 68; - 67; - 67; - 67; - 67; 67; 67; 67; 67; + 70; 67; 67; 67; @@ -1993,97 +2022,8 @@ let _htmlstream_indicies : int array = 67; 67; 67; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 69; - 69; - 70; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 6; - 6; - 6; 71; - 6; - 6; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 6; - 6; - 6; - 6; - 69; - 6; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 69; - 6; + 67; 72; 72; 72; @@ -3169,6 +3109,38 @@ let _htmlstream_indicies : int array = 21; 122; 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 126; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; + 125; 124; 124; 124; @@ -3183,6 +3155,7 @@ let _htmlstream_indicies : int array = 124; 124; 124; + 125; 124; 124; 124; @@ -3197,91 +3170,8 @@ let _htmlstream_indicies : int array = 124; 124; 124; - 124; - 124; - 124; - 124; - 124; - 124; - 126; - 126; - 124; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 124; - 124; - 124; 127; 124; - 124; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 124; - 124; - 124; - 124; - 126; - 124; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 126; - 124; 14; 6; 6; @@ -5893,9 +5783,9 @@ let _htmlstream_trans_targs : int array = 22; 22; 22; + 23; 24; 24; - 23; 27; 31; 24; @@ -5950,9 +5840,9 @@ let _htmlstream_trans_targs : int array = 0; 38; 38; + 39; 38; 38; - 39; 0; 42; 42; @@ -6091,9 +5981,9 @@ let _htmlstream_trans_actions : int array = 2; 0; 4; + 0; 24; 25; - 0; 24; 24; 0; @@ -6148,9 +6038,9 @@ let _htmlstream_trans_actions : int array = 32; 0; 4; + 0; 33; 34; - 0; 33; 1; 35; diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 7d89554..bd3ca4d 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -105,6 +105,7 @@ let emit_many scanner tokens = wsp = 0..32; ident = alnum | '-' | [_:.] ; + tag_name = ident ( any - ( wsp | '/' | '>' ) )*; in_script := (count_newlines | any* >mark %mark_end :>> @@ -141,8 +142,8 @@ let emit_many scanner tokens = '"' ^'"'* >mark %mark_end '"' | ^(wsp|'"'|"'"|'>')+ >mark %mark_end); tag_attrs = (wsp+ | ident+ >mark %key wsp* ('=' wsp* literal)? %store_attr )**; - close_tag = '/' wsp* ident* >mark %close_tag <: ^'>'* '>'; - open_tag = ident+ >mark %tag <: wsp* tag_attrs + close_tag = '/' wsp* tag_name? >mark %close_tag <: ^'>'* '>'; + open_tag = tag_name >mark %tag <: wsp* tag_attrs ('/' wsp* '>' %tag_done_2 | '>' %tag_done); directive = ('!'|'?') (alnum ident+) >mark %directive <: wsp* tag_attrs '?'? '>' %directive_done; From 9a44e20d3e9f0ec6adbe7884336f2bf2551312cd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:05:46 +0000 Subject: [PATCH 049/109] fix: decode character references exactly like src/baseline --- src/lite/html_entity_decoder.ml | 256 ++++++++++++---------------- src/lite/ragel_html_tokenizer.ml | 6 +- src/lite/ragel_html_tokenizer.ml.rl | 7 +- 3 files changed, 115 insertions(+), 154 deletions(-) diff --git a/src/lite/html_entity_decoder.ml b/src/lite/html_entity_decoder.ml index ae8ea69..fa025f2 100644 --- a/src/lite/html_entity_decoder.ml +++ b/src/lite/html_entity_decoder.ml @@ -1,174 +1,132 @@ (* This file is part of Markup.ml, released under the MIT license. See LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) -let replacement = Uchar.of_int 0xFFFD +open Common +module Trie = Markup_entities.Trie -exception Undecodable_chunk - -type reference = Codepoint of int | Name of string -type entity = One of int | Two of int * int - -let html4_names = - "lt gt amp quot apos nbsp iexcl cent pound curren yen brvbar sect uml copy \ - ordf laquo not shy reg macr deg plusmn sup2 sup3 acute micro para middot \ - cedil sup1 ordm raquo frac14 frac12 frac34 iquest Agrave Aacute Acirc \ - Atilde Auml Aring AElig Ccedil Egrave Eacute Ecirc Euml Igrave Iacute Icirc \ - Iuml ETH Ntilde Ograve Oacute Ocirc Otilde Ouml times Oslash Ugrave Uacute \ - Ucirc Uuml Yacute THORN szlig agrave aacute acirc atilde auml aring aelig \ - ccedil egrave eacute ecirc euml igrave iacute icirc iuml eth ntilde ograve \ - oacute ocirc otilde ouml divide oslash ugrave uacute ucirc uuml yacute \ - thorn yuml fnof Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa \ - Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Psi Omega alpha \ - beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi omicron \ - pi rho sigmaf sigma tau upsilon phi chi psi omega thetasym upsih piv bull \ - hellip prime Prime oline frasl weierp image real trade alefsym larr uarr \ - rarr darr harr crarr lArr uArr rArr dArr hArr forall part exist empty nabla \ - isin notin ni prod sum minus lowast radic prop infin ang and or cap cup int \ - there4 sim cong asymp ne equiv le ge sub sup nsub sube supe oplus otimes \ - perp sdot lceil rceil lfloor rfloor lang rang loz spades clubs hearts diams \ - OElig oelig Scaron scaron Yuml circ tilde ensp emsp thinsp zwnj zwj lrm rlm \ - ndash mdash lsquo rsquo sbquo ldquo rdquo bdquo dagger Dagger permil lsaquo \ - rsaquo euro" - -module Str_tbl = Hashtbl.Make (struct - type t = string - - let equal = String.equal - let hash = Hashtbl.hash -end) - -let split_words s = - let rec scan start index words = - if index = String.length s then - if start = index then List.rev words - else List.rev (String.sub s start (index - start) :: words) - else if s.[index] = ' ' then - if start = index then scan (index + 1) (index + 1) words - else - scan (index + 1) (index + 1) - (String.sub s start (index - start) :: words) - else scan start (index + 1) words - in - scan 0 0 [] - -let named_entities = +let named_entity_trie = lazy - (let names = Str_tbl.create 253 in - List.iter (fun name -> Str_tbl.add names name ()) (split_words html4_names); - let entities = Str_tbl.create 253 in - Array.iter - (fun (name, value) -> - if Str_tbl.mem names name then - let value = - match value with - | `One codepoint -> One codepoint - | `Two (first, second) -> Two (first, second) - in - Str_tbl.replace entities name value) - Markup_entities.Entities.entities; - (* HTML5 changed [lang] and [rang], and its legacy no-semicolon [sup1] - entry collides with [sup] in the generated table. *) - Str_tbl.replace entities "sup" (One 0x2283); - Str_tbl.replace entities "lang" (One 0x2329); - Str_tbl.replace entities "rang" (One 0x232A); - entities) - -let is_undecodable codepoint = - (codepoint >= 0xD800 && codepoint <= 0xDFFF) - || codepoint = 0xFFFE || codepoint = 0xFFFF - -let add_uchar buffer codepoint = - if is_undecodable codepoint then raise Undecodable_chunk; - let uchar = - try Uchar.of_int codepoint with Invalid_argument _ -> replacement - in - Uutf.Buffer.add_utf_8 buffer uchar - -let add_utf_8 buffer text position length = - Uutf.String.fold_utf_8 ~pos:position ~len:length - (fun () _ -> function - | `Uchar uchar -> - if is_undecodable (Uchar.to_int uchar) then raise Undecodable_chunk; - Uutf.Buffer.add_utf_8 buffer uchar - | `Malformed _ -> invalid_arg "malformed UTF-8") - () text - -let[@inline] is_letter = function 'A' .. 'Z' | 'a' .. 'z' -> true | _ -> false -let[@inline] is_decimal = function '0' .. '9' -> true | _ -> false -let[@inline] is_alphanumeric c = is_letter c || is_decimal c - -let[@inline] is_hexadecimal = function - | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true - | _ -> false - -let[@inline] hexadecimal_value = function - | '0' .. '9' as c -> Char.code c - Char.code '0' - | 'A' .. 'F' as c -> Char.code c - Char.code 'A' + 10 - | 'a' .. 'f' as c -> Char.code c - Char.code 'a' + 10 - | _ -> assert false - -let decode_references text = + (Array.fold_left + (fun trie (name, characters) -> Trie.add name characters trie) + (Trie.create ()) Markup_entities.Entities.entities) + +let replace_windows_1252_entity = function + | 0x80 -> 0x20AC + | 0x82 -> 0x201A + | 0x83 -> 0x0192 + | 0x84 -> 0x201E + | 0x85 -> 0x2026 + | 0x86 -> 0x2020 + | 0x87 -> 0x2021 + | 0x88 -> 0x02C6 + | 0x89 -> 0x2030 + | 0x8A -> 0x0160 + | 0x8B -> 0x2039 + | 0x8C -> 0x0152 + | 0x8E -> 0x017D + | 0x91 -> 0x2018 + | 0x92 -> 0x2019 + | 0x93 -> 0x201C + | 0x94 -> 0x201D + | 0x95 -> 0x2022 + | 0x96 -> 0x2013 + | 0x97 -> 0x2014 + | 0x98 -> 0x02DC + | 0x99 -> 0x2122 + | 0x9A -> 0x0161 + | 0x9B -> 0x203A + | 0x9C -> 0x0153 + | 0x9E -> 0x017E + | 0x9F -> 0x0178 + | c -> c + +let[@inline] is_decimal c = is_digit (Char.code c) +let[@inline] is_hexadecimal c = is_hex_digit (Char.code c) +let[@inline] is_alphanumeric_char c = is_alphanumeric (Char.code c) + +let decode_references in_attribute text = let length = String.length text in let buffer = Buffer.create length in + let numeric_value ~hexadecimal digits finish = + let digits = String.sub text digits (finish - digits) in + let value = + int_of_string_opt (if hexadecimal then "0x" ^ digits else digits) + in + match value with + | None -> u_rep + | Some value -> + let value = replace_windows_1252_entity value in + if value = 0 || not (is_scalar value) then u_rep else value + in let rec search copied index = - if index >= length then add_utf_8 buffer text copied (length - copied) + if index >= length then + Buffer.add_substring buffer text copied (length - copied) else if text.[index] <> '&' then search copied (index + 1) else - match reference_end text (index + 1) with + match reference (index + 1) with | None -> search copied (index + 1) | Some (after, value) -> - add_utf_8 buffer text copied (index - copied); + Buffer.add_substring buffer text copied (index - copied); begin match value with - | Codepoint codepoint -> add_uchar buffer codepoint - | Name name -> - begin match Str_tbl.find_opt (Lazy.force named_entities) name with - | Some (One codepoint) -> add_uchar buffer codepoint - | Some (Two (first, second)) -> - add_uchar buffer first; - add_uchar buffer second - | None -> Uutf.Buffer.add_utf_8 buffer replacement - end + | `One codepoint -> add_utf_8 buffer codepoint + | `Two (first, second) -> + add_utf_8 buffer first; + add_utf_8 buffer second end; search after after - and reference_end text start = - if start >= length then None - else if text.[start] = '#' then numeric_reference text (start + 1) - else if is_letter text.[start] then - let finish = consume_while text (start + 1) is_alphanumeric in - if finish < length && text.[finish] = ';' then - Some (finish + 1, Name (String.sub text start (finish - start))) - else None - else None - and numeric_reference text start = + and reference start = if start >= length then None - else if text.[start] = 'x' || text.[start] = 'X' then + else + match text.[start] with + | '\t' | '\n' | '\x0C' | ' ' | '<' | '&' -> None + | '#' -> numeric_reference (start + 1) + | _ -> named_reference start + and numeric_reference start = + if start < length && (text.[start] = 'x' || text.[start] = 'X') then let digits = start + 1 in - let finish = consume_while text digits is_hexadecimal in - if finish > digits && finish < length && text.[finish] = ';' then begin - let value = ref 0 in - for index = digits to finish - 1 do - value := (!value lsl 4) lor hexadecimal_value text.[index] - done; - Some (finish + 1, Codepoint !value) - end - else None + let finish = consume_while digits is_hexadecimal in + if finish = digits then None + else + Some (terminate finish (numeric_value ~hexadecimal:true digits finish)) else - let finish = consume_while text start is_decimal in - if finish > start && finish < length && text.[finish] = ';' then - Some - ( finish + 1, - Codepoint (int_of_string (String.sub text start (finish - start))) - ) - else None - and consume_while text index predicate = + let finish = consume_while start is_decimal in + if finish = start then None + else + Some (terminate finish (numeric_value ~hexadecimal:false start finish)) + and terminate finish value = + if finish < length && text.[finish] = ';' then (finish + 1, `One value) + else (finish, `One value) + and named_reference start = + let rec walk best index trie = + if index >= length then best + else + let trie = Trie.advance (Char.code text.[index]) trie in + match Trie.matches trie with + | Trie.No -> best + | Trie.Prefix -> walk best (index + 1) trie + | Trie.Multiple value -> walk (Some (index + 1, value)) (index + 1) trie + | Trie.Yes value -> Some (index + 1, value) + in + match walk None start (Lazy.force named_entity_trie) with + | None -> None + | Some (name_end, value) -> + if name_end < length && text.[name_end] = ';' then + Some (name_end + 1, value) + else if + in_attribute && name_end < length + && (is_alphanumeric_char text.[name_end] || text.[name_end] = '=') + then None + else Some (name_end, value) + and consume_while index predicate = if index < length && predicate text.[index] then - consume_while text (index + 1) predicate + consume_while (index + 1) predicate else index in search 0 0; Buffer.contents buffer let decode text = - if String.contains text '&' then - try decode_references text with Undecodable_chunk -> text - else text + if String.contains text '&' then decode_references false text else text + +let decode_attribute text = + if String.contains text '&' then decode_references true text else text diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index c686b40..6ec2adc 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -29,10 +29,12 @@ type t = { mutable finished : bool; } -let decode text = try Html_entity_decoder.decode text with _ -> text +let decode = Html_entity_decoder.decode let attributes attrs = - List.map (fun (name, value) -> (name, decode value)) attrs + List.map + (fun (name, value) -> (name, Html_entity_decoder.decode_attribute value)) + attrs let make_tag name attributes = { Token_tag.name; attributes; self_closing = false } diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index bd3ca4d..cb6a09f 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -32,11 +32,12 @@ type t = { mutable finished : bool; } -let decode text = - try Html_entity_decoder.decode text with _ -> text +let decode = Html_entity_decoder.decode let attributes attrs = - List.map (fun (name, value) -> name, decode value) attrs + List.map + (fun (name, value) -> name, Html_entity_decoder.decode_attribute value) + attrs let make_tag name attributes = {Token_tag.name; attributes; self_closing = false} From da3c46d589018dd0e944b5c7d8d08cff18ddde3b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:06:49 +0000 Subject: [PATCH 050/109] fix: normalize CR and CRLF to LF like src/baseline --- src/lite/token_source.ml | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 8ff9c7e..a28a3e6 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -30,8 +30,30 @@ let replace_malformed html = () html; Buffer.contents buffer +let normalize_newlines html = + if not (String.contains html '\r') then html + else begin + let length = String.length html in + let buffer = Buffer.create length in + let rec copy index = + if index < length then + match html.[index] with + | '\r' -> + Buffer.add_char buffer '\n'; + if index + 1 < length && html.[index + 1] = '\n' then + copy (index + 2) + else copy (index + 1) + | c -> + Buffer.add_char buffer c; + copy (index + 1) + in + copy 0; + Buffer.contents buffer + end + let create html = let html = if valid_utf_8 html then html else replace_malformed html in + let html = normalize_newlines html in { scanner = Ragel_html_tokenizer.create html; pushed = [] } let location () = { line = 1; column = -1 } From 23f14a184bf62cec760f73c3e3d378914dcb6d76 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:10:03 +0000 Subject: [PATCH 051/109] fix: strip BOM like src/baseline --- src/lite/token_source.ml | 25 +++++++++++++++++++++++++ test/lite/lite_baseline_regression.ml | 5 +++++ 2 files changed, 30 insertions(+) diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index a28a3e6..0ed37ad 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -51,8 +51,33 @@ let normalize_newlines html = Buffer.contents buffer end +(* Like src/baseline: the uutf decoder drops a leading BOM, then the input + preprocessor drops the first U+FEFF found anywhere in the stream. *) +let remove_first_bom html = + let length = String.length html in + let rec find index = + if index + 3 > length then None + else if + html.[index] = '\xEF' + && html.[index + 1] = '\xBB' + && html.[index + 2] = '\xBF' + then Some index + else find (index + 1) + in + match find 0 with + | None -> html + | Some index -> + String.sub html 0 index ^ String.sub html (index + 3) (length - index - 3) + +let strip_leading_bom html = + let bom = "\xEF\xBB\xBF" in + if String.length html >= 3 && String.sub html 0 3 = bom then + remove_first_bom (String.sub html 3 (String.length html - 3)) + else remove_first_bom html + let create html = let html = if valid_utf_8 html then html else replace_malformed html in + let html = strip_leading_bom html in let html = normalize_newlines html in { scanner = Ragel_html_tokenizer.create html; pushed = [] } diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 7e346f5..49251da 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -70,6 +70,11 @@ let () = >::: [ agrees "crlf in text" "

a\r\nb

"; agrees "lone cr" "a\rb"; ]; + "bom" + >::: [ + agrees "leading bom" "\xEF\xBB\xBFa"; + agrees "bom in text" "a\xEF\xBB\xBFb"; + ]; "garbage tags" >::: [ agrees "at sign in name" "z"; From 7b143b5a52e29c8e07c37bd3e7d1e7311b7d8de2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:17:27 +0000 Subject: [PATCH 052/109] fix: emit comments, bogus comments, and doctypes like src/baseline --- src/lite/dune | 3 +- src/lite/markup_declaration.ml | 319 + src/lite/ragel_html_tokenizer.ml | 9619 +++++++++++---------------- src/lite/ragel_html_tokenizer.ml.rl | 35 +- 4 files changed, 4300 insertions(+), 5676 deletions(-) create mode 100644 src/lite/markup_declaration.ml diff --git a/src/lite/dune b/src/lite/dune index 86257b5..a15f311 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -8,7 +8,8 @@ (public_name markup.lite) (synopsis "Small fast synchronous HTML parser") (private_modules common error html_entity_decoder html_parser html_tokenizer - html_writer kstream namespace ragel_html_tokenizer text token_source) + html_writer kstream markup_declaration namespace ragel_html_tokenizer text + token_source) (libraries markup.common markup.entities uutf) (flags (:standard -w -9))) diff --git a/src/lite/markup_declaration.ml b/src/lite/markup_declaration.ml new file mode 100644 index 0000000..d559e7f --- /dev/null +++ b/src/lite/markup_declaration.ml @@ -0,0 +1,319 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* Port of the comment, bogus comment, and doctype tokenizer states of + src/baseline/html_tokenizer.ml, operating on the normalized input string. + [scan] is given the index of the '!' or '?' that follows '<' and returns + the token together with the index of the first unconsumed byte. *) + +open Common + +type result = { token : Html_tokenizer.token; next : int } + +let u_rep_utf_8 = "\xEF\xBF\xBD" + +let add buffer byte = + if byte = '\x00' then Buffer.add_string buffer u_rep_utf_8 + else Buffer.add_char buffer byte + +let is_whitespace = function '\t' | '\n' | '\x0C' | ' ' -> true | _ -> false + +let matches_lowercase data index keyword = + index + String.length keyword <= String.length data + && begin + let rec check offset = + offset >= String.length keyword + || Char.lowercase_ascii data.[index + offset] = keyword.[offset] + && check (offset + 1) + in + check 0 + end + +let bogus_comment data start = + let length = String.length data in + let buffer = Buffer.create 32 in + let rec consume index = + if index >= length then + { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index } + else + match data.[index] with + | '>' -> + { + token = Html_tokenizer.Comment (Buffer.contents buffer); + next = index + 1; + } + | byte -> + add buffer byte; + consume (index + 1) + in + consume start + +let comment data start = + let length = String.length data in + let buffer = Buffer.create 64 in + let finish index = + { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index } + in + let rec comment_start index = + if index >= length then finish index + else + match data.[index] with + | '-' -> comment_start_dash (index + 1) + | '>' -> finish (index + 1) + | byte -> + add buffer byte; + comment_text (index + 1) + and comment_start_dash index = + if index >= length then finish index + else + match data.[index] with + | '-' -> comment_end (index + 1) + | '>' -> finish (index + 1) + | byte -> + Buffer.add_char buffer '-'; + add buffer byte; + comment_text (index + 1) + and comment_text index = + if index >= length then finish index + else + match data.[index] with + | '-' -> comment_end_dash (index + 1) + | byte -> + add buffer byte; + comment_text (index + 1) + and comment_end_dash index = + if index >= length then finish index + else + match data.[index] with + | '-' -> comment_end (index + 1) + | byte -> + Buffer.add_char buffer '-'; + add buffer byte; + comment_text (index + 1) + and comment_end index = + if index >= length then finish index + else + match data.[index] with + | '>' -> finish (index + 1) + | '!' -> comment_end_bang (index + 1) + | '-' -> + Buffer.add_char buffer '-'; + comment_end (index + 1) + | byte -> + Buffer.add_string buffer "--"; + add buffer byte; + comment_text (index + 1) + and comment_end_bang index = + if index >= length then finish index + else + match data.[index] with + | '-' -> + Buffer.add_string buffer "--!"; + comment_end_dash (index + 1) + | '>' -> finish (index + 1) + | byte -> + Buffer.add_string buffer "--!"; + add buffer byte; + comment_text (index + 1) + in + comment_start start + +let doctype data start = + let length = String.length data in + let name = ref None in + let public_identifier = ref None in + let system_identifier = ref None in + let quirks = ref false in + let add_to field byte = + let buffer = + match !field with + | Some buffer -> buffer + | None -> + let buffer = Buffer.create 32 in + field := Some buffer; + buffer + in + add buffer byte + in + let finish ?(force_quirks = false) index = + if force_quirks then quirks := true; + let contents field = + match !field with + | None -> None + | Some buffer -> Some (Buffer.contents buffer) + in + { + token = + Html_tokenizer.Doctype + { + doctype_name = contents name; + public_identifier = contents public_identifier; + system_identifier = contents system_identifier; + raw_text = None; + force_quirks = !quirks; + }; + next = index; + } + in + let rec doctype_start index = + if index >= length then finish ~force_quirks:true index + else if is_whitespace data.[index] then before_name (index + 1) + else before_name index + and before_name index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then before_name (index + 1) + else if byte = '>' then finish ~force_quirks:true (index + 1) + else begin + add_to name (Char.lowercase_ascii byte); + name_state (index + 1) + end + and name_state index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then after_name (index + 1) + else if byte = '>' then finish (index + 1) + else begin + add_to name (Char.lowercase_ascii byte); + name_state (index + 1) + end + and after_name index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then after_name (index + 1) + else if byte = '>' then finish (index + 1) + else if matches_lowercase data index "public" then + after_public_keyword (index + 6) + else if matches_lowercase data index "system" then + after_system_keyword (index + 6) + else begin + quirks := true; + bogus index + end + and after_public_keyword index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then before_public_identifier (index + 1) + else if byte = '"' || byte = '\'' then begin + public_identifier := Some (Buffer.create 32); + identifier_quoted public_identifier byte after_public_identifier + (index + 1) + end + else if byte = '>' then finish ~force_quirks:true (index + 1) + else begin + quirks := true; + bogus (index + 1) + end + and before_public_identifier index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then before_public_identifier (index + 1) + else if byte = '"' || byte = '\'' then begin + public_identifier := Some (Buffer.create 32); + identifier_quoted public_identifier byte after_public_identifier + (index + 1) + end + else if byte = '>' then finish ~force_quirks:true (index + 1) + else begin + quirks := true; + bogus (index + 1) + end + and identifier_quoted field quote next_state index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if byte = quote then next_state (index + 1) + else if byte = '>' then finish ~force_quirks:true (index + 1) + else begin + add_to field byte; + identifier_quoted field quote next_state (index + 1) + end + and after_public_identifier index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then between_identifiers (index + 1) + else if byte = '>' then finish (index + 1) + else if byte = '"' || byte = '\'' then begin + system_identifier := Some (Buffer.create 32); + identifier_quoted system_identifier byte after_system_identifier + (index + 1) + end + else begin + quirks := true; + bogus (index + 1) + end + and between_identifiers index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then between_identifiers (index + 1) + else if byte = '>' then finish (index + 1) + else if byte = '"' || byte = '\'' then begin + system_identifier := Some (Buffer.create 32); + identifier_quoted system_identifier byte after_system_identifier + (index + 1) + end + else begin + quirks := true; + bogus (index + 1) + end + and after_system_keyword index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then before_system_identifier (index + 1) + else if byte = '"' || byte = '\'' then begin + system_identifier := Some (Buffer.create 32); + identifier_quoted system_identifier byte after_system_identifier + (index + 1) + end + else if byte = '>' then finish ~force_quirks:true (index + 1) + else begin + quirks := true; + bogus (index + 1) + end + and before_system_identifier index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then before_system_identifier (index + 1) + else if byte = '"' || byte = '\'' then begin + system_identifier := Some (Buffer.create 32); + identifier_quoted system_identifier byte after_system_identifier + (index + 1) + end + else if byte = '>' then finish ~force_quirks:true (index + 1) + else begin + quirks := true; + bogus (index + 1) + end + and after_system_identifier index = + if index >= length then finish ~force_quirks:true index + else + let byte = data.[index] in + if is_whitespace byte then after_system_identifier (index + 1) + else if byte = '>' then finish (index + 1) + else bogus (index + 1) + and bogus index = + if index >= length then finish index + else if data.[index] = '>' then finish (index + 1) + else bogus (index + 1) + in + doctype_start start + +let scan data index = + if data.[index] = '?' then bogus_comment data (index + 1) + else if + index + 3 <= String.length data + && data.[index + 1] = '-' + && data.[index + 2] = '-' + then comment data (index + 3) + else if matches_lowercase data (index + 1) "doctype" then + doctype data (index + 8) + else bogus_comment data (index + 1) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 6ec2adc..68bb237 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -20,7 +20,7 @@ type t = { tag : string ref; key : string ref; attrs : (string * string) list ref; - directive : string ref; + mutable declaration : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -61,44 +61,6 @@ let _htmlstream_trans_keys : int array = 122; 10; 10; - 10; - 122; - 10; - 45; - 10; - 45; - 10; - 45; - 10; - 62; - 10; - 122; - 0; - 122; - 0; - 122; - 0; - 122; - 0; - 122; - 0; - 62; - 0; - 62; - 10; - 60; - 10; - 34; - 10; - 34; - 0; - 122; - 10; - 62; - 10; - 39; - 10; - 39; 0; 62; 0; @@ -134,8 +96,6 @@ let _htmlstream_trans_keys : int array = 0; 62; 10; - 122; - 10; 60; 10; 60; @@ -213,25 +173,6 @@ let _htmlstream_key_spans : int array = 51; 123; 1; - 113; - 36; - 36; - 36; - 53; - 113; - 123; - 123; - 123; - 123; - 63; - 63; - 51; - 25; - 25; - 123; - 53; - 30; - 30; 63; 123; 123; @@ -249,7 +190,6 @@ let _htmlstream_key_spans : int array = 123; 53; 63; - 113; 51; 51; 61; @@ -295,75 +235,55 @@ let _htmlstream_index_offsets : int array = 104; 228; 230; - 344; - 381; + 294; 418; - 455; - 509; - 623; - 747; - 871; - 995; - 1119; - 1183; - 1247; - 1299; - 1325; - 1351; - 1475; - 1529; - 1560; - 1591; - 1655; - 1779; - 1903; - 2027; - 2091; - 2143; - 2207; - 2271; - 2323; + 542; + 666; + 730; + 782; + 846; + 910; + 962; + 988; + 1014; + 1138; + 1169; + 1200; + 1324; + 1378; + 1442; + 1494; + 1546; + 1608; + 1725; + 1816; + 1922; + 2019; + 2123; + 2231; + 2295; + 2297; 2349; - 2375; - 2499; - 2530; - 2561; - 2685; - 2739; - 2803; - 2917; - 2969; - 3021; - 3083; - 3200; - 3291; - 3397; - 3494; - 3598; - 3706; - 3770; - 3772; - 3824; - 3876; - 3938; - 4055; - 4163; - 4276; - 4376; - 4469; - 4533; - 4535; - 4587; - 4639; - 4701; - 4819; - 4916; - 5024; - 5124; - 5217; - 5281; - 5283; - 5337; + 2401; + 2463; + 2580; + 2688; + 2801; + 2901; + 2994; + 3058; + 3060; + 3112; + 3164; + 3226; + 3344; + 3441; + 3549; + 3649; + 3742; + 3806; + 3808; + 3862; |]; ] @@ -538,7 +458,7 @@ let _htmlstream_indicies : int array = 6; 6; 6; - 11; + 8; 6; 9; 9; @@ -599,9 +519,105 @@ let _htmlstream_indicies : int array = 9; 9; 6; - 13; 12; + 11; 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 15; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 16; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 17; + 13; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 19; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; 6; 6; 6; @@ -614,17 +630,118 @@ let _htmlstream_indicies : int array = 6; 6; 6; + 20; + 20; + 21; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; 6; 6; 6; + 22; 6; 6; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; 6; 6; 6; 6; + 20; 6; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; + 20; 6; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 24; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; 6; 6; 6; @@ -636,100 +753,119 @@ let _htmlstream_indicies : int array = 6; 6; 6; - 15; - 6; - 6; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 6; - 6; - 6; - 6; - 6; - 6; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 6; - 14; - 6; - 6; - 6; 6; + 25; + 25; + 26; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; 6; 6; + 27; + 28; 6; 6; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; 6; 6; 6; 6; + 25; 6; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; + 25; 6; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 30; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; + 29; 6; 6; 6; @@ -742,162 +878,118 @@ let _htmlstream_indicies : int array = 6; 6; 6; + 31; + 31; + 32; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; 6; 6; + 33; + 34; 6; 6; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; 6; 6; 6; 6; - 17; - 6; - 18; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 19; - 17; - 18; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 20; - 17; - 18; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 20; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 17; - 21; - 17; - 14; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; + 31; 6; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; 6; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 35; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; + 21; 6; 6; 6; @@ -915,242 +1007,338 @@ let _htmlstream_indicies : int array = 6; 6; 6; - 22; - 22; 6; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; 6; 6; 6; 6; 6; 6; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; 6; 6; 6; 6; - 22; - 6; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 6; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 24; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 22; - 22; - 6; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 6; - 6; - 6; - 25; - 26; - 6; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; 6; + 36; 6; + 38; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 37; + 39; + 37; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 41; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 33; + 40; + 42; + 40; + 40; + 40; + 40; + 43; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; + 40; 6; + 40; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 46; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 45; + 44; 6; - 22; + 44; + 44; + 44; + 44; 6; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; - 22; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 44; + 47; + 44; + 49; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 48; + 50; + 48; + 52; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 51; + 53; + 51; + 55; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 54; + 56; + 54; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 58; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; + 57; 6; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 28; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; 6; 6; 6; @@ -1162,569 +1350,117 @@ let _htmlstream_indicies : int array = 6; 6; 6; + 31; + 31; + 32; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; 6; - 29; - 29; 6; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; 6; + 34; 6; 6; - 30; 31; - 6; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 6; - 6; - 6; - 6; - 29; - 6; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 6; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 33; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 32; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 34; - 34; - 6; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 6; - 6; - 35; - 36; - 37; - 6; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 6; - 6; - 6; - 6; - 34; - 6; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 34; - 6; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 39; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 38; - 6; - 6; - 6; - 6; - 6; - 6; - 6; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; 6; 6; 6; 6; + 31; 6; - 40; - 40; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; + 31; 6; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 6; - 41; - 42; - 43; - 6; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 6; - 6; - 6; - 40; - 6; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 45; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 41; - 44; - 46; - 44; - 44; - 44; - 44; - 47; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 6; - 44; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 50; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 49; - 48; - 6; - 48; - 48; - 48; - 48; - 6; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 51; - 48; + 60; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; + 59; 53; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 52; - 54; - 52; - 56; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 55; - 57; - 55; 59; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 58; - 60; - 58; - 61; - 61; - 61; + 62; 61; 61; 61; @@ -1732,7 +1468,6 @@ let _htmlstream_indicies : int array = 61; 61; 61; - 62; 61; 61; 61; @@ -1754,214 +1489,152 @@ let _htmlstream_indicies : int array = 61; 61; 61; + 56; 61; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 40; - 40; - 6; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 6; - 6; - 42; - 43; - 6; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 6; - 6; - 6; - 40; - 6; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 14; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 30; - 6; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 65; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; + 64; 64; 63; 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 57; - 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; + 63; 66; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 65; - 60; - 65; + 66; + 63; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 63; + 63; + 63; + 67; + 63; + 63; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 63; + 63; + 63; + 63; + 66; + 63; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 66; + 63; + 69; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; + 68; 68; 68; 68; @@ -1972,7 +1645,6 @@ let _htmlstream_indicies : int array = 68; 68; 68; - 69; 68; 68; 68; @@ -1995,37 +1667,8 @@ let _htmlstream_indicies : int array = 68; 68; 68; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; 70; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 67; - 71; - 67; + 68; 72; 72; 72; @@ -2059,221 +1702,203 @@ let _htmlstream_indicies : int array = 72; 72; 72; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 74; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 72; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; + 71; 74; + 71; + 76; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; + 75; 75; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 6; - 6; - 6; - 76; - 6; - 6; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 6; - 6; - 6; - 6; - 74; - 6; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 74; - 6; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 78; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; - 77; 77; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 79; + 75; 79; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; 80; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 6; - 6; + 78; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; 81; 82; - 6; - 6; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 6; - 6; - 6; - 6; - 79; - 6; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 79; - 6; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 81; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 83; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; 83; 83; 83; @@ -2307,3409 +1932,2229 @@ let _htmlstream_indicies : int array = 83; 83; 83; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; 85; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; 85; + 78; + 79; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 78; + 78; + 78; + 78; + 78; 86; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 6; - 6; - 87; - 88; - 6; - 6; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 6; - 6; - 6; - 6; - 85; - 6; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 6; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 89; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 90; - 6; - 92; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 91; - 93; - 91; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 95; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 87; - 94; - 96; - 94; - 94; - 94; - 94; - 97; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 94; - 6; - 94; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 100; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 99; - 98; - 6; - 98; - 98; - 98; - 98; - 6; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 101; - 98; - 103; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 102; - 104; - 102; - 106; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 105; - 107; - 105; - 109; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 108; - 110; - 108; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 112; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 111; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 85; - 85; - 86; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 6; - 6; - 6; - 88; - 6; - 6; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 6; - 6; - 6; - 6; - 85; - 6; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 85; - 6; - 114; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 113; - 107; - 113; - 116; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 115; - 110; - 115; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 119; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 118; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 120; - 120; - 117; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 117; - 117; - 117; - 121; - 117; - 117; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 117; - 117; - 117; - 117; - 120; - 117; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 117; - 123; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 21; - 122; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 126; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 125; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 125; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 124; - 127; - 124; - 14; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 6; - 6; - 6; - 6; - 6; - 6; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 16; - 6; - 129; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 130; - 128; - 132; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 135; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 134; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 136; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 137; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 136; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 138; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 138; - 131; - 132; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 131; - 131; - 131; - 131; - 131; - 139; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 139; - 131; - 132; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 140; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 140; - 131; - 132; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 141; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 141; - 131; - 132; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 133; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 142; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 142; - 131; - 132; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 86; + 78; + 79; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 87; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 87; + 78; + 79; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 88; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 88; + 78; + 79; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 89; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 89; + 78; + 79; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 90; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 90; + 78; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 91; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 90; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 78; + 80; + 78; + 92; + 78; + 94; + 93; + 96; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 95; + 97; + 95; + 99; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 102; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 101; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 103; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 104; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 103; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 105; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 105; + 98; + 99; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 106; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 106; + 98; + 99; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 107; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 107; + 98; + 99; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 108; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 108; + 98; + 99; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 109; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 109; + 98; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 110; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 109; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 98; + 100; + 98; + 111; + 98; + 113; + 112; + 115; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 114; + 116; + 114; + 118; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 121; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 120; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 122; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 123; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 122; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 124; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 124; + 117; + 118; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 125; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 125; + 117; + 118; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 126; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 126; + 117; + 118; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 127; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 127; + 117; + 118; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 128; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 128; + 117; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 129; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 128; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 117; + 119; + 117; + 130; + 117; + 132; 131; + 134; 133; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 143; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 143; - 131; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 144; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 143; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; - 131; 133; - 131; - 145; - 131; - 147; - 146; - 149; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 148; - 150; - 148; - 152; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 155; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 154; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 156; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 157; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 156; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 158; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 158; - 151; - 152; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 159; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 159; - 151; - 152; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 160; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 160; - 151; - 152; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 161; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 161; - 151; - 152; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 162; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 162; - 151; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 163; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 162; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 151; - 153; - 151; - 164; - 151; - 166; - 165; - 168; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 167; - 169; - 167; - 171; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 174; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 173; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 175; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 176; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 175; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 177; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 177; - 170; - 171; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 178; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 178; - 170; - 171; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 179; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 179; - 170; - 171; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 180; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 180; - 170; - 171; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 181; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 181; - 170; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 182; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 181; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 170; - 172; - 170; - 183; - 170; - 185; - 184; - 187; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 186; - 188; - 186; - 190; - 189; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 133; + 135; + 133; + 137; + 136; 0; |]; ] @@ -5726,136 +4171,121 @@ let _htmlstream_trans_targs : int array = 2; 3; 2; + 0; 4; - 23; - 37; - 40; - 3; + 18; 3; 3; + 4; + 5; + 5; + 8; + 12; + 5; 5; - 9; 6; + 8; + 12; + 7; + 7; 6; + 8; + 10; + 12; 7; + 7; + 6; 8; - 0; 10; + 12; + 8; + 9; + 1; + 1; + 2; 11; - 11; + 10; + 13; 16; - 20; - 11; 11; + 5; + 5; 12; - 16; - 20; - 13; - 13; - 12; + 1; + 1; + 2; 14; - 16; - 20; - 13; - 13; - 12; 14; - 16; - 20; 15; 14; - 17; - 21; + 14; 15; - 11; - 11; - 16; - 1; - 1; - 2; - 18; - 18; + 5; + 5; + 17; + 17; + 17; + 17; 19; 18; 18; + 20; + 0; 19; - 11; - 11; + 19; + 0; + 20; + 19; + 19; + 0; 22; 22; + 23; 22; 22; 23; + 23; + 23; 24; 24; - 27; - 31; - 24; - 24; - 25; - 27; - 31; - 26; - 26; - 25; - 27; - 29; - 31; - 26; - 26; - 25; - 27; - 29; - 31; + 25; + 26; 27; 28; - 1; - 1; - 2; - 30; 29; - 32; - 35; 30; - 24; - 24; + 30; + 31; + 31; 31; - 1; - 1; - 2; 33; 33; 34; 33; 33; 34; - 24; - 24; - 36; - 36; - 36; + 34; + 34; + 35; + 35; 36; - 38; 37; - 37; - 39; - 0; - 38; 38; 39; - 38; - 38; - 0; - 42; - 42; + 40; + 40; + 41; + 41; + 41; 43; - 42; - 42; 43; + 44; 43; 43; 44; 44; + 44; + 45; 45; 46; 47; @@ -5866,49 +4296,11 @@ let _htmlstream_trans_targs : int array = 51; 51; 51; + 52; + 52; 53; 53; - 54; - 53; 53; - 54; - 54; - 54; - 55; - 55; - 56; - 57; - 58; - 59; - 60; - 60; - 61; - 61; - 61; - 63; - 63; - 64; - 63; - 63; - 64; - 64; - 64; - 65; - 65; - 66; - 67; - 68; - 69; - 70; - 70; - 71; - 71; - 71; - 72; - 72; - 73; - 73; - 73; |]; ] @@ -5926,19 +4318,10 @@ let _htmlstream_trans_actions : int array = 4; 6; 7; - 6; - 6; - 0; - 4; 8; 0; - 1; - 0; 4; 0; - 0; - 0; - 0; 9; 10; 9; @@ -5951,105 +4334,61 @@ let _htmlstream_trans_actions : int array = 11; 12; 0; - 11; 13; + 11; 13; 0; 4; 14; - 0; 15; + 0; 15; + 4; + 0; + 17; + 18; + 16; 1; 4; 0; 0; 0; - 16; - 17; - 16; 19; 20; - 18; - 1; - 2; - 21; - 0; - 4; + 19; 22; - 15; 23; + 21; 1; 2; - 0; - 4; - 0; 24; - 25; - 24; - 24; - 0; - 4; - 1; - 0; - 0; - 11; - 12; - 0; - 13; - 11; - 13; 0; 4; - 14; - 15; - 0; + 25; 15; - 4; - 0; - 27; - 28; 26; 1; - 4; - 0; - 0; - 0; - 16; - 17; - 16; - 30; - 31; - 29; - 1; - 2; - 21; - 0; - 4; - 22; - 15; - 23; - 1; 2; 0; 4; - 32; + 27; 0; 4; 1; - 32; + 27; 0; 4; 0; - 33; - 34; - 33; + 0; + 28; + 29; + 28; 1; - 35; - 21; + 30; + 24; 0; 4; - 22; + 25; 0; 4; 0; @@ -6061,15 +4400,15 @@ let _htmlstream_trans_actions : int array = 0; 0; 4; - 36; + 31; 0; 4; 1; - 35; - 21; + 30; + 24; 0; 4; - 22; + 25; 0; 4; 0; @@ -6080,15 +4419,15 @@ let _htmlstream_trans_actions : int array = 0; 0; 4; - 37; + 32; 0; 4; 1; - 35; - 21; + 30; + 24; 0; 4; - 22; + 25; 0; 4; 0; @@ -6099,12 +4438,12 @@ let _htmlstream_trans_actions : int array = 0; 0; 4; - 38; + 33; 0; 4; 0; 4; - 39; + 34; 0; 4; |]; @@ -6123,30 +4462,10 @@ let _htmlstream_eof_actions : int array = 5; 5; 5; + 16; 5; 5; - 5; - 5; - 5; - 5; - 5; - 18; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 26; - 5; - 5; - 29; - 5; + 21; 5; 5; 5; @@ -6194,10 +4513,10 @@ let _htmlstream_eof_actions : int array = let htmlstream_start : int = 0 let htmlstream_first_final : int = 0 let htmlstream_error : int = -1 -let htmlstream_en_in_script : int = 41 -let htmlstream_en_in_style : int = 52 -let htmlstream_en_in_title : int = 62 -let htmlstream_en_garbage_tag : int = 72 +let htmlstream_en_in_script : int = 21 +let htmlstream_en_in_style : int = 32 +let htmlstream_en_in_title : int = 42 +let htmlstream_en_garbage_tag : int = 52 let htmlstream_en_main : int = 0 type _htmlstream_state = { mutable keys : int; mutable trans : int } @@ -6225,7 +4544,7 @@ let create data = tag = ref ""; key = ref ""; attrs = ref []; - directive = ref ""; + declaration = -1; line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -6245,7 +4564,6 @@ let run scanner = let tag = scanner.tag in let key = scanner.key in let attrs = scanner.attrs in - let directive = scanner.directive in pe := !eof; let pause () = if scanner.write >= buffer_capacity - maximum_transition_output && !p < !eof @@ -6262,496 +4580,408 @@ let run scanner = mark_end := -1; text in + if scanner.declaration >= 0 then begin + let start = scanner.declaration in + scanner.declaration <- -1; + let result = Markup_declaration.scan data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else begin + begin + let state = { keys = 0; trans = 0 } in + let rec do_start () = + if p.contents = pe.contents then do_test_eof () else do_resume () + and do_resume () = + begin try + let keys = cs.contents lsl 1 in + let inds = _htmlstream_index_offsets.(cs.contents) in - begin - let state = { keys = 0; trans = 0 } in - let rec do_start () = - if p.contents = pe.contents then do_test_eof () else do_resume () - and do_resume () = - begin try - let keys = cs.contents lsl 1 in - let inds = _htmlstream_index_offsets.(cs.contents) in - - let slen = _htmlstream_key_spans.(cs.contents) in - state.trans <- - _htmlstream_indicies.(inds - + - if - slen > 0 - && _htmlstream_trans_keys.(keys) - <= Char.code data.[p.contents] - && Char.code data.[p.contents] - <= _htmlstream_trans_keys.(keys + 1) - then - Char.code data.[p.contents] - - _htmlstream_trans_keys.(keys) - else slen) - with Goto_match_htmlstream -> () - end; - do_eof_trans () - and do_eof_trans () = - cs.contents <- _htmlstream_trans_targs.(state.trans); + let slen = _htmlstream_key_spans.(cs.contents) in + state.trans <- + _htmlstream_indicies.(inds + + + if + slen > 0 + && _htmlstream_trans_keys.(keys) + <= Char.code data.[p.contents] + && Char.code data.[p.contents] + <= _htmlstream_trans_keys.(keys + 1) + then + Char.code data.[p.contents] + - _htmlstream_trans_keys.(keys) + else slen) + with Goto_match_htmlstream -> () + end; + do_eof_trans () + and do_eof_trans () = + cs.contents <- _htmlstream_trans_targs.(state.trans); - begin try - if _htmlstream_trans_actions.(state.trans) = 0 then - raise_notrace Goto_again_htmlstream; + begin try + if _htmlstream_trans_actions.(state.trans) = 0 then + raise_notrace Goto_again_htmlstream; - match _htmlstream_trans_actions.(state.trans) with - | 1 -> - begin - mark := !p - end; - () - | 22 -> - begin - mark_end := !p - end; - () - | 24 -> - begin - tag := String.lowercase_ascii @@ sub (); - attrs := [] - end; - () - | 33 -> - begin - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause () - end; - () - | 9 -> - begin - directive := String.lowercase_ascii @@ sub (); - attrs := [] - end; - () - | 3 -> - begin - emit scanner (String (decode (sub ()))); - pause () - end; - () - | 11 -> - begin - key := String.lowercase_ascii @@ sub () - end; - () - | 15 -> - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - () - | 29 -> - begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 41; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 52; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 62; - if true then raise_notrace Goto_again_htmlstream - end - | "" -> () - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); + match _htmlstream_trans_actions.(state.trans) with + | 1 -> + begin + mark := !p + end; + () + | 25 -> + begin + mark_end := !p + end; + () + | 9 -> + begin + tag := String.lowercase_ascii @@ sub (); + attrs := [] + end; + () + | 28 -> + begin + let name = String.lowercase_ascii @@ sub () in + emit scanner (End (make_tag name [])); + pause () + end; + () + | 3 -> + begin + emit scanner (String (decode (sub ()))); pause () - end; - () - | 26 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () - end; - () - | 39 -> - begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 41; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 52; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 62; - if true then raise_notrace Goto_again_htmlstream - end - | "" -> begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause (); - begin + end; + () + | 11 -> + begin + key := String.lowercase_ascii @@ sub () + end; + () + | 15 -> + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + () + | 21 -> + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner (Start (make_tag name (attributes !attrs))); + pause () + end; + () + | 16 -> + begin + let start = Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; End (make_tag !tag []) ]; + pause () + end; + () + | 34 -> + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> begin cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end - end; - () - | 18 -> - begin end; - () - | 5 -> - begin - p.contents <- p.contents - 1; + | name -> + emit scanner (Start (make_tag name (attributes !attrs))); + pause (); + begin + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream + end + end; + () + | 5 -> begin - cs.contents <- 72; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 4 -> - begin - scanner.line <- scanner.line + 1 - end; - () - | 6 -> - begin - tag := "" - end; - () - | 21 -> - begin - mark := !p - end; - begin - mark_end := !p - end; - () - | 32 -> - begin - mark := !p - end; - begin - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause () - end; - () - | 2 -> - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 16 -> - begin - mark_end := !p - end; - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - () - | 25 -> - begin - tag := String.lowercase_ascii @@ sub (); - attrs := [] - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 34 -> - begin - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause () - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 10 -> - begin - directive := String.lowercase_ascii @@ sub (); - attrs := [] - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 13 -> - begin - key := String.lowercase_ascii @@ sub () - end; - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - () - | 12 -> - begin - key := String.lowercase_ascii @@ sub () - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 14 -> - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - begin - mark := !p - end; - () - | 23 -> - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 30 -> - begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 41; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> p.contents <- p.contents - 1; begin cs.contents <- 52; if true then raise_notrace Goto_again_htmlstream end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 62; - if true then raise_notrace Goto_again_htmlstream - end - | "" -> () - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); + end; + () + | 4 -> + begin + scanner.line <- scanner.line + 1 + end; + () + | 8 -> + begin + tag := "" + end; + () + | 24 -> + begin + mark := !p + end; + begin + mark_end := !p + end; + () + | 27 -> + begin + mark := !p + end; + begin + let name = String.lowercase_ascii @@ sub () in + emit scanner (End (make_tag name [])); pause () - end; - begin - mark := !p - end; - () - | 27 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () - end; - begin - mark := !p - end; - () - | 19 -> - begin end; - begin - mark := !p - end; - () - | 8 -> - begin - p.contents <- p.contents - 1; + end; + () + | 2 -> + begin + mark := !p + end; begin - cs.contents <- 72; - if true then raise_notrace Goto_again_htmlstream - end - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 35 -> - begin - scanner.line <- scanner.line + 1 - end; - begin - mark := !p - end; - () - | 36 -> - begin - emit_many scanner - [ - Start (make_tag "script" (attributes !attrs)); - String (sub ()); - End (make_tag "script" []); - ]; - pause () - end; - begin + scanner.line <- scanner.line + 1 + end; + () + | 19 -> + begin + mark_end := !p + end; begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 37 -> - begin - emit_many scanner - [ - Start (make_tag "style" (attributes !attrs)); - String (sub ()); - End (make_tag "style" []); - ]; - pause () - end; - begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + () + | 10 -> begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 38 -> - begin - emit_many scanner - [ - Start (make_tag "title" (attributes !attrs)); - String (decode (sub ())); - End (make_tag "title" []); - ]; - pause () - end; - begin + tag := String.lowercase_ascii @@ sub (); + attrs := [] + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 29 -> + begin + let name = String.lowercase_ascii @@ sub () in + emit scanner (End (make_tag name [])); + pause () + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 13 -> + begin + key := String.lowercase_ascii @@ sub () + end; + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + () + | 12 -> + begin + key := String.lowercase_ascii @@ sub () + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 14 -> + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + begin + mark := !p + end; + () + | 26 -> + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 22 -> + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner (Start (make_tag name (attributes !attrs))); + pause () + end; + begin + mark := !p + end; + () + | 17 -> + begin + let start = Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; End (make_tag !tag []) ]; + pause () + end; + begin + mark := !p + end; + () + | 30 -> + begin + scanner.line <- scanner.line + 1 + end; + begin + mark := !p + end; + () + | 31 -> + begin + emit_many scanner + [ + Start (make_tag "script" (attributes !attrs)); + String (sub ()); + End (make_tag "script" []); + ]; + pause () + end; begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 7 -> - begin - tag := "" - end; - begin - mark := !p - end; - () - | 17 -> - begin - mark_end := !p - end; - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 31 -> - begin match !tag with - | "script" -> - p.contents <- p.contents - 1; begin - cs.contents <- 41; + cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end - | "style" -> - p.contents <- p.contents - 1; + end; + () + | 32 -> + begin + emit_many scanner + [ + Start (make_tag "style" (attributes !attrs)); + String (sub ()); + End (make_tag "style" []); + ]; + pause () + end; + begin begin - cs.contents <- 52; + cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end - | "title" -> - p.contents <- p.contents - 1; + end; + () + | 33 -> + begin + emit_many scanner + [ + Start (make_tag "title" (attributes !attrs)); + String (decode (sub ())); + End (make_tag "title" []); + ]; + pause () + end; + begin begin - cs.contents <- 62; + cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end - | "" -> () - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause () - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 28 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 20 -> - begin end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | _ -> () - with Goto_again_htmlstream -> () - end; - - do_again () - and do_again () = - p.contents <- p.contents + 1; - if p.contents <> pe.contents then do_resume () else do_test_eof () - and do_test_eof () = - if p.contents = eof.contents then - begin try - begin match _htmlstream_eof_actions.(cs.contents) with - | 3 -> + end; + () + | 7 -> begin - emit scanner (String (decode (sub ()))); - pause () + tag := "" + end; + begin + mark := !p end; () - | 29 -> + | 6 -> + begin + tag := "" + end; + begin + scanner.declaration <- !p; + pe := !p + 1 + end; + () + | 20 -> + begin + mark_end := !p + end; + begin + attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 23 -> begin match !tag with | "script" -> p.contents <- p.contents - 1; begin - cs.contents <- 41; + cs.contents <- 21; if true then raise_notrace Goto_again_htmlstream end | "style" -> p.contents <- p.contents - 1; begin - cs.contents <- 52; + cs.contents <- 32; if true then raise_notrace Goto_again_htmlstream end | "title" -> p.contents <- p.contents - 1; begin - cs.contents <- 62; + cs.contents <- 42; if true then raise_notrace Goto_again_htmlstream end | "" -> () @@ -6759,39 +4989,102 @@ let run scanner = emit scanner (Start (make_tag name (attributes !attrs))); pause () end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; () - | 26 -> + | 18 -> begin let start = Start (make_tag !tag (attributes !attrs)) in if !tag = "a" || !tag = "br" then emit scanner start else emit_many scanner [ start; End (make_tag !tag []) ]; pause () end; - () - | 18 -> - begin end; - () - | 5 -> begin - p.contents <- p.contents - 1; - begin - cs.contents <- 72; - if true then raise_notrace Goto_again_htmlstream - end + mark := !p + end; + begin + scanner.line <- scanner.line + 1 end; () | _ -> () + with Goto_again_htmlstream -> () + end; + + do_again () + and do_again () = + p.contents <- p.contents + 1; + if p.contents <> pe.contents then do_resume () else do_test_eof () + and do_test_eof () = + if p.contents = eof.contents then + begin try + begin match _htmlstream_eof_actions.(cs.contents) with + | 3 -> + begin + emit scanner (String (decode (sub ()))); + pause () + end; + () + | 21 -> + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner (Start (make_tag name (attributes !attrs))); + pause () + end; + () + | 16 -> + begin + let start = Start (make_tag !tag (attributes !attrs)) in + if !tag = "a" || !tag = "br" then emit scanner start + else emit_many scanner [ start; End (make_tag !tag []) ]; + pause () + end; + () + | 5 -> + begin + p.contents <- p.contents - 1; + begin + cs.contents <- 52; + if true then raise_notrace Goto_again_htmlstream + end + end; + () + | _ -> () + end + with + | Goto_again_htmlstream -> do_again () + | Goto_eof_trans_htmlstream -> do_eof_trans () end - with - | Goto_again_htmlstream -> do_again () - | Goto_eof_trans_htmlstream -> do_eof_trans () - end - in - do_start () - end; + in + do_start () + end; - if !p >= !eof then scanner.finished <- true - else if scanner.write = 0 then scanner.finished <- true + if scanner.declaration >= 0 then () + else if !p >= !eof then scanner.finished <- true + else if scanner.write = 0 then scanner.finished <- true + end let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = if scanner.read < scanner.write then begin diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index cb6a09f..affae72 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -23,7 +23,7 @@ type t = { tag : string ref; key : string ref; attrs : (string * string) list ref; - directive : string ref; + mutable declaration : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -64,7 +64,6 @@ let emit_many scanner tokens = emit scanner (End (make_tag name [])); pause (); } - action directive { directive := String.lowercase_ascii @@ sub (); attrs := []; } action text { emit scanner (String (decode (sub ()))); pause (); @@ -98,7 +97,7 @@ let emit_many scanner tokens = pause (); fgoto main; } - action directive_done { } + action markup_declaration { scanner.declaration <- !p; pe := !p + 1; } action garbage_tag { fhold; fgoto garbage_tag; } @@ -146,11 +145,9 @@ let emit_many scanner tokens = close_tag = '/' wsp* tag_name? >mark %close_tag <: ^'>'* '>'; open_tag = tag_name >mark %tag <: wsp* tag_attrs ('/' wsp* '>' %tag_done_2 | '>' %tag_done); - directive = ('!'|'?') (alnum ident+) >mark %directive <: - wsp* tag_attrs '?'? '>' %directive_done; - comment = "!--" any* :>> "-->"; + declaration = ('!'|'?') @markup_declaration; tag = '<' wsp* <: - (close_tag | open_tag | directive | comment) + (close_tag | open_tag | declaration) @lerr(garbage_tag) >{ tag := "" }; main := (((tag | ^'<' >mark ^'<'* %text ) )** | count_newlines); @@ -171,7 +168,7 @@ let create data = tag = ref ""; key = ref ""; attrs = ref []; - directive = ref ""; + declaration = (-1); line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -190,7 +187,6 @@ let run scanner = let tag = scanner.tag in let key = scanner.key in let attrs = scanner.attrs in - let directive = scanner.directive in pe := !eof; let pause () = if scanner.write >= buffer_capacity - maximum_transition_output && @@ -209,9 +205,24 @@ let run scanner = mark_end := -1; text in - %%write exec; - if !p >= !eof then scanner.finished <- true - else if scanner.write = 0 then scanner.finished <- true + if scanner.declaration >= 0 then begin + let start = scanner.declaration in + scanner.declaration <- (-1); + let result = Markup_declaration.scan data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else begin + %%write exec; + if scanner.declaration >= 0 then () + else if !p >= !eof then scanner.finished <- true + else if scanner.write = 0 then scanner.finished <- true + end let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = From 05bf31a369a52fdab90972a909d84d014f52cf64 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:19:28 +0000 Subject: [PATCH 053/109] fix: attribute source order and duplicate handling like src/baseline --- src/lite/ragel_html_tokenizer.ml | 14 +++++++++++--- src/lite/ragel_html_tokenizer.ml.rl | 14 +++++++++++--- test/lite/lite_baseline_regression.ml | 5 +++++ 3 files changed, 27 insertions(+), 6 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 68bb237..92af708 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -31,10 +31,18 @@ type t = { let decode = Html_entity_decoder.decode +(* [attrs] is accumulated in reverse source order; the first occurrence of a + name wins, like src/baseline. *) let attributes attrs = - List.map - (fun (name, value) -> (name, Html_entity_decoder.decode_attribute value)) - attrs + let rec dedupe seen = function + | [] -> [] + | (name, value) :: rest -> + if List.mem name seen then dedupe seen rest + else + (name, Html_entity_decoder.decode_attribute value) + :: dedupe (name :: seen) rest + in + dedupe [] (List.rev attrs) let make_tag name attributes = { Token_tag.name; attributes; self_closing = false } diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index affae72..4a10ae0 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -34,10 +34,18 @@ type t = { let decode = Html_entity_decoder.decode +(* [attrs] is accumulated in reverse source order; the first occurrence of a + name wins, like src/baseline. *) let attributes attrs = - List.map - (fun (name, value) -> name, Html_entity_decoder.decode_attribute value) - attrs + let rec dedupe seen = function + | [] -> [] + | (name, value) :: rest -> + if List.mem name seen then dedupe seen rest + else + (name, Html_entity_decoder.decode_attribute value) + :: dedupe (name :: seen) rest + in + dedupe [] (List.rev attrs) let make_tag name attributes = {Token_tag.name; attributes; self_closing = false} diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 49251da..575a35f 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -75,6 +75,11 @@ let () = agrees "leading bom" "\xEF\xBB\xBFa"; agrees "bom in text" "a\xEF\xBB\xBFb"; ]; + "attributes" + >::: [ + agrees "source order" "

x"; + agrees "duplicates" "

x"; + ]; "garbage tags" >::: [ agrees "at sign in name" "z"; From b48255cd0dd04ade920d036a3af9a032cd009789 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:24:01 +0000 Subject: [PATCH 054/109] fix: self-closing start tags carry the flag like src/baseline --- src/lite/ragel_html_tokenizer.ml | 124 +++++++++++++++++++++++----- src/lite/ragel_html_tokenizer.ml.rl | 17 ++-- 2 files changed, 113 insertions(+), 28 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 92af708..b5dd44a 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -44,8 +44,8 @@ let attributes attrs = in dedupe [] (List.rev attrs) -let make_tag name attributes = - { Token_tag.name; attributes; self_closing = false } +let make_tag ?(self_closing = false) name attributes = + { Token_tag.name; attributes; self_closing } let buffer_capacity = 128 let maximum_transition_output = 3 @@ -4701,11 +4701,31 @@ let run scanner = end; () | 16 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner + (Start + (make_tag ~self_closing:true name (attributes !attrs))); + pause () end; () | 34 -> @@ -4875,11 +4895,31 @@ let run scanner = end; () | 17 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner + (Start + (make_tag ~self_closing:true name (attributes !attrs))); + pause () end; begin mark := !p @@ -5005,11 +5045,31 @@ let run scanner = end; () | 18 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner + (Start + (make_tag ~self_closing:true name (attributes !attrs))); + pause () end; begin mark := !p @@ -5063,11 +5123,31 @@ let run scanner = end; () | 16 -> - begin - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [ start; End (make_tag !tag []) ]; - pause () + begin match !tag with + | "script" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 21; + if true then raise_notrace Goto_again_htmlstream + end + | "style" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 32; + if true then raise_notrace Goto_again_htmlstream + end + | "title" -> + p.contents <- p.contents - 1; + begin + cs.contents <- 42; + if true then raise_notrace Goto_again_htmlstream + end + | "" -> () + | name -> + emit scanner + (Start + (make_tag ~self_closing:true name (attributes !attrs))); + pause () end; () | 5 -> diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 4a10ae0..462a373 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -47,8 +47,8 @@ let attributes attrs = in dedupe [] (List.rev attrs) -let make_tag name attributes = - {Token_tag.name; attributes; self_closing = false} +let make_tag ?(self_closing = false) name attributes = + {Token_tag.name; attributes; self_closing} let buffer_capacity = 128 let maximum_transition_output = 3 @@ -89,10 +89,15 @@ let emit_many scanner tokens = pause (); } action tag_done_2 { - let start = Start (make_tag !tag (attributes !attrs)) in - if !tag = "a" || !tag = "br" then emit scanner start - else emit_many scanner [start; End (make_tag !tag [])]; - pause (); + match !tag with + | "script" -> fhold; fgoto in_script; + | "style" -> fhold; fgoto in_style; + | "title" -> fhold; fgoto in_title; + | "" -> () + | name -> + emit scanner + (Start (make_tag ~self_closing:true name (attributes !attrs))); + pause (); } action garbage_tag_done { match !tag with From e379f81ab14aacf6a29a7b69912b1eeffe1691ac Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:25:50 +0000 Subject: [PATCH 055/109] fix: svg and math fragment contexts are foreign like src/baseline --- src/lite/html_parser.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index f02255c..76157b6 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -224,12 +224,15 @@ end = struct let initialize requested_context state _throw k = let context = match requested_context with - | `Fragment element -> + | `Fragment element -> ( (* HTML element names are case-insensitive, even in foreign content. Lowercase the element name given by the user before analysis by the parser, to match this convention. [String.lowercase] is acceptable here because the API assumes the string [element] is in UTF-8. *) - Fragment (HTML, String.lowercase_ascii element) + match String.lowercase_ascii element with + | "math" -> Fragment (MathML, "math") + | "svg" -> Fragment (SVG, "svg") + | element -> Fragment (HTML, element)) | `Document -> Document in let context_element = From 83056bd989d20e39d88bb730e46c264007042f51 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:42:12 +0000 Subject: [PATCH 056/109] fix: scan script, style, title, and textarea bodies like src/baseline --- src/lite/dune | 4 +- src/lite/ragel_html_tokenizer.ml | 3064 ++------------------------- src/lite/ragel_html_tokenizer.ml.rl | 91 +- src/lite/raw_text.ml | 301 +++ test/lite/dune | 5 + 5 files changed, 485 insertions(+), 2980 deletions(-) create mode 100644 src/lite/raw_text.ml diff --git a/src/lite/dune b/src/lite/dune index a15f311..3a01f54 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -8,8 +8,8 @@ (public_name markup.lite) (synopsis "Small fast synchronous HTML parser") (private_modules common error html_entity_decoder html_parser html_tokenizer - html_writer kstream markup_declaration namespace ragel_html_tokenizer text - token_source) + html_writer kstream markup_declaration namespace ragel_html_tokenizer + raw_text text token_source) (libraries markup.common markup.entities uutf) (flags (:standard -w -9))) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index b5dd44a..6279885 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -21,6 +21,7 @@ type t = { key : string ref; attrs : (string * string) list ref; mutable declaration : int; + mutable raw_text : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -57,6 +58,25 @@ let emit scanner token = let emit_many scanner tokens = List.iter (emit scanner) tokens +(* The tree builder treats a leading whitespace run differently from the rest + of a text run in several insertion modes; src/baseline gets this for free + from per-character tokens. *) +let emit_text scanner text = + let length = String.length text in + let rec whitespace_end index = + if index < length then + match text.[index] with + | '\t' | '\n' | '\x0C' | '\r' | ' ' -> whitespace_end (index + 1) + | _ -> index + else index + in + let boundary = whitespace_end 0 in + if boundary = 0 || boundary = length then emit scanner (String text) + else begin + emit scanner (String (String.sub text 0 boundary)); + emit scanner (String (String.sub text boundary (length - boundary))) + end + let _htmlstream_trans_keys : int array = Array.concat [ @@ -104,68 +124,6 @@ let _htmlstream_trans_keys : int array = 0; 62; 10; - 60; - 10; - 60; - 0; - 60; - 0; - 115; - 10; - 99; - 10; - 114; - 10; - 105; - 10; - 112; - 10; - 116; - 0; - 62; - 10; - 10; - 10; - 60; - 10; - 60; - 0; - 60; - 0; - 115; - 10; - 116; - 10; - 121; - 10; - 108; - 10; - 101; - 0; - 62; - 10; - 10; - 10; - 60; - 10; - 60; - 0; - 60; - 0; - 116; - 10; - 105; - 10; - 116; - 10; - 108; - 10; - 101; - 0; - 62; - 10; - 10; - 10; 62; 10; 10; @@ -198,37 +156,6 @@ let _htmlstream_key_spans : int array = 123; 53; 63; - 51; - 51; - 61; - 116; - 90; - 105; - 96; - 103; - 107; - 63; - 1; - 51; - 51; - 61; - 116; - 107; - 112; - 99; - 92; - 63; - 1; - 51; - 51; - 61; - 117; - 96; - 107; - 99; - 92; - 63; - 1; 53; 1; |]; @@ -260,38 +187,7 @@ let _htmlstream_index_offsets : int array = 1324; 1378; 1442; - 1494; - 1546; - 1608; - 1725; - 1816; - 1922; - 2019; - 2123; - 2231; - 2295; - 2297; - 2349; - 2401; - 2463; - 2580; - 2688; - 2801; - 2901; - 2994; - 3058; - 3060; - 3112; - 3164; - 3226; - 3344; - 3441; - 3549; - 3649; - 3742; - 3806; - 3808; - 3862; + 1496; |]; ] @@ -1791,2378 +1687,12 @@ let _htmlstream_indicies : int array = 75; 75; 75; + 75; + 75; 77; 75; 79; 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 82; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 81; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 83; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 84; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 83; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 85; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 85; - 78; - 79; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 78; - 78; - 78; - 78; - 78; - 86; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 86; - 78; - 79; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 87; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 87; - 78; - 79; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 88; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 88; - 78; - 79; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 89; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 89; - 78; - 79; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 90; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 90; - 78; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 91; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 90; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 78; - 80; - 78; - 92; - 78; - 94; - 93; - 96; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 95; - 97; - 95; - 99; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 102; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 101; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 103; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 104; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 103; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 105; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 105; - 98; - 99; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 106; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 106; - 98; - 99; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 107; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 107; - 98; - 99; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 108; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 108; - 98; - 99; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 109; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 109; - 98; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 110; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 109; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 98; - 100; - 98; - 111; - 98; - 113; - 112; - 115; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 114; - 116; - 114; - 118; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 121; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 120; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 122; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 123; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 122; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 124; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 124; - 117; - 118; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 125; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 125; - 117; - 118; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 126; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 126; - 117; - 118; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 127; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 127; - 117; - 118; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 128; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 128; - 117; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 129; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 128; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 117; - 119; - 117; - 130; - 117; - 132; - 131; - 134; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 133; - 135; - 133; - 137; - 136; 0; |]; ] @@ -4246,69 +1776,11 @@ let _htmlstream_trans_targs : int array = 19; 19; 0; + 21; + 21; 22; 22; - 23; - 22; 22; - 23; - 23; - 23; - 24; - 24; - 25; - 26; - 27; - 28; - 29; - 30; - 30; - 31; - 31; - 31; - 33; - 33; - 34; - 33; - 33; - 34; - 34; - 34; - 35; - 35; - 36; - 37; - 38; - 39; - 40; - 40; - 41; - 41; - 41; - 43; - 43; - 44; - 43; - 43; - 44; - 44; - 44; - 45; - 45; - 46; - 47; - 48; - 49; - 50; - 50; - 51; - 51; - 51; - 52; - 52; - 53; - 53; - 53; |]; ] @@ -4326,132 +1798,74 @@ let _htmlstream_trans_actions : int array = 4; 6; 7; - 8; - 0; - 4; - 0; - 9; - 10; - 9; - 9; - 0; - 4; - 1; - 0; - 0; - 11; - 12; - 0; - 13; - 11; - 13; - 0; - 4; - 14; - 15; - 0; - 15; - 4; - 0; - 17; - 18; - 16; - 1; - 4; - 0; - 0; - 0; - 19; - 20; - 19; - 22; - 23; - 21; - 1; - 2; - 24; - 0; - 4; - 25; - 15; - 26; - 1; - 2; - 0; - 4; - 27; - 0; - 4; - 1; - 27; - 0; - 4; - 0; - 0; - 28; - 29; - 28; - 1; - 30; - 24; - 0; - 4; - 25; - 0; - 4; - 0; - 4; - 0; - 0; - 0; - 0; - 0; - 0; - 4; - 31; - 0; - 4; - 1; - 30; - 24; + 8; 0; 4; - 25; 0; - 4; + 9; + 10; + 9; + 9; 0; 4; + 1; 0; 0; + 11; + 12; 0; + 13; + 11; + 13; 0; + 4; + 14; + 15; 0; + 15; 4; - 32; 0; + 17; + 18; + 16; + 1; 4; + 0; + 0; + 0; + 19; + 20; + 19; + 22; + 23; + 21; 1; - 30; + 2; 24; 0; 4; 25; + 15; + 26; + 1; + 2; 0; 4; + 27; 0; 4; - 0; - 0; - 0; - 0; + 1; + 27; 0; 4; - 33; 0; - 4; + 0; + 28; + 29; + 28; 0; 4; - 34; + 30; 0; 4; |]; @@ -4461,70 +1875,14 @@ let _htmlstream_eof_actions : int array = Array.concat [ [| - 0; - 3; - 5; - 0; - 5; - 5; - 5; - 5; - 5; - 16; - 5; - 5; - 21; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 5; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; + 0; 3; 5; 0; 5; 5; 5; 5; 5; 16; 5; 5; 21; 5; 5; 5; 5; 5; 5; 5; 5; 0; 0; |]; ] let htmlstream_start : int = 0 let htmlstream_first_final : int = 0 let htmlstream_error : int = -1 -let htmlstream_en_in_script : int = 21 -let htmlstream_en_in_style : int = 32 -let htmlstream_en_in_title : int = 42 -let htmlstream_en_garbage_tag : int = 52 +let htmlstream_en_garbage_tag : int = 21 let htmlstream_en_main : int = 0 type _htmlstream_state = { mutable keys : int; mutable trans : int } @@ -4553,6 +1911,7 @@ let create data = key = ref ""; attrs = ref []; declaration = -1; + raw_text = -1; line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -4588,7 +1947,22 @@ let run scanner = mark_end := -1; text in - if scanner.declaration >= 0 then begin + if scanner.raw_text >= 0 then begin + let start = scanner.raw_text in + scanner.raw_text <- -1; + let name = !tag in + let result = Raw_text.scan data start name in + emit scanner (Start (make_tag name (attributes !attrs))); + emit scanner (String result.Raw_text.text); + if result.Raw_text.had_end_tag then emit scanner (End (make_tag name [])); + for index = start to result.Raw_text.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Raw_text.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.declaration >= 0 then begin let start = scanner.declaration in scanner.declaration <- -1; let result = Markup_declaration.scan data start in @@ -4660,7 +2034,7 @@ let run scanner = () | 3 -> begin - emit scanner (String (decode (sub ()))); + emit_text scanner (decode (sub ())); pause () end; () @@ -4676,25 +2050,11 @@ let run scanner = () | 21 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause () @@ -4702,25 +2062,11 @@ let run scanner = () | 16 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start @@ -4728,30 +2074,15 @@ let run scanner = pause () end; () - | 34 -> + | 30 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> begin cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p + 1; + pe := !p + 1 | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause (); @@ -4765,7 +2096,7 @@ let run scanner = begin p.contents <- p.contents - 1; begin - cs.contents <- 52; + cs.contents <- 21; if true then raise_notrace Goto_again_htmlstream end end; @@ -4867,25 +2198,11 @@ let run scanner = () | 22 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause () @@ -4896,25 +2213,11 @@ let run scanner = () | 17 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start @@ -4925,65 +2228,6 @@ let run scanner = mark := !p end; () - | 30 -> - begin - scanner.line <- scanner.line + 1 - end; - begin - mark := !p - end; - () - | 31 -> - begin - emit_many scanner - [ - Start (make_tag "script" (attributes !attrs)); - String (sub ()); - End (make_tag "script" []); - ]; - pause () - end; - begin - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 32 -> - begin - emit_many scanner - [ - Start (make_tag "style" (attributes !attrs)); - String (sub ()); - End (make_tag "style" []); - ]; - pause () - end; - begin - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 33 -> - begin - emit_many scanner - [ - Start (make_tag "title" (attributes !attrs)); - String (decode (sub ())); - End (make_tag "title" []); - ]; - pause () - end; - begin - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () | 7 -> begin tag := "" @@ -5014,25 +2258,11 @@ let run scanner = () | 23 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause () @@ -5046,25 +2276,11 @@ let run scanner = () | 18 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start @@ -5092,31 +2308,17 @@ let run scanner = begin match _htmlstream_eof_actions.(cs.contents) with | 3 -> begin - emit scanner (String (decode (sub ()))); + emit_text scanner (decode (sub ())); pause () end; () | 21 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause () @@ -5124,25 +2326,11 @@ let run scanner = () | 16 -> begin match !tag with - | "script" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 21; - if true then raise_notrace Goto_again_htmlstream - end - | "style" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 32; - if true then raise_notrace Goto_again_htmlstream - end - | "title" -> - p.contents <- p.contents - 1; - begin - cs.contents <- 42; - if true then raise_notrace Goto_again_htmlstream - end | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 | name -> emit scanner (Start @@ -5154,7 +2342,7 @@ let run scanner = begin p.contents <- p.contents - 1; begin - cs.contents <- 52; + cs.contents <- 21; if true then raise_notrace Goto_again_htmlstream end end; @@ -5169,7 +2357,7 @@ let run scanner = do_start () end; - if scanner.declaration >= 0 then () + if scanner.declaration >= 0 || scanner.raw_text >= 0 then () else if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 462a373..b8f647f 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -24,6 +24,7 @@ type t = { key : string ref; attrs : (string * string) list ref; mutable declaration : int; + mutable raw_text : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -61,6 +62,25 @@ let emit scanner token = let emit_many scanner tokens = List.iter (emit scanner) tokens +(* The tree builder treats a leading whitespace run differently from the rest + of a text run in several insertion modes; src/baseline gets this for free + from per-character tokens. *) +let emit_text scanner text = + let length = String.length text in + let rec whitespace_end index = + if index < length then + match text.[index] with + | '\t' | '\n' | '\x0C' | '\r' | ' ' -> whitespace_end (index + 1) + | _ -> index + else index + in + let boundary = whitespace_end 0 in + if boundary = 0 || boundary = length then emit scanner (String text) + else begin + emit scanner (String (String.sub text 0 boundary)); + emit scanner (String (String.sub text boundary (length - boundary))) + end + %%{ machine htmlstream; @@ -73,27 +93,29 @@ let emit_many scanner tokens = pause (); } action text { - emit scanner (String (decode (sub ()))); + emit_text scanner (decode (sub ())); pause (); } action key { key := String.lowercase_ascii @@ sub () } action store_attr { attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs } action tag_done { match !tag with - | "script" -> fhold; fgoto in_script; - | "style" -> fhold; fgoto in_style; - | "title" -> fhold; fgoto in_title; | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + fhold; + pe := !p + 1; | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause (); } action tag_done_2 { match !tag with - | "script" -> fhold; fgoto in_script; - | "style" -> fhold; fgoto in_style; - | "title" -> fhold; fgoto in_title; | "" -> () + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p; + fhold; + pe := !p + 1; | name -> emit scanner (Start (make_tag ~self_closing:true name (attributes !attrs))); @@ -101,10 +123,10 @@ let emit_many scanner tokens = } action garbage_tag_done { match !tag with - | "script" -> fhold; fgoto in_script; - | "style" -> fhold; fgoto in_style; - | "title" -> fhold; fgoto in_title; | "" -> fgoto main; + | "script" | "style" | "title" | "textarea" -> + scanner.raw_text <- !p + 1; + pe := !p + 1; | name -> emit scanner (Start (make_tag name (attributes !attrs))); pause (); @@ -120,34 +142,6 @@ let emit_many scanner tokens = ident = alnum | '-' | [_:.] ; tag_name = ident ( any - ( wsp | '/' | '>' ) )*; - in_script := - (count_newlines | any* >mark %mark_end :>> - ('<' wsp* '/' wsp* 'script'i wsp* '>' >{ - emit_many scanner - [Start (make_tag "script" (attributes !attrs)); - String (sub ()); - End (make_tag "script" [])]; - pause (); - } @{fgoto main;})); - in_style := - (count_newlines | any* >mark %mark_end :>> - ('<' wsp* '/' wsp* 'style'i wsp* '>' >{ - emit_many scanner - [Start (make_tag "style" (attributes !attrs)); - String (sub ()); - End (make_tag "style" [])]; - pause (); - } @{fgoto main;})); - in_title := - (count_newlines | any* >mark %mark_end :>> - ('<' wsp* '/' wsp* 'title'i wsp* '>' >{ - emit_many scanner - [Start (make_tag "title" (attributes !attrs)); - String (decode (sub ())); - End (make_tag "title" [])]; - pause (); - } @{fgoto main;})); - garbage_tag := (count_newlines | ^'>'* '>' @garbage_tag_done); literal = @@ -182,6 +176,7 @@ let create data = key = ref ""; attrs = ref []; declaration = (-1); + raw_text = (-1); line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -218,7 +213,23 @@ let run scanner = mark_end := -1; text in - if scanner.declaration >= 0 then begin + if scanner.raw_text >= 0 then begin + let start = scanner.raw_text in + scanner.raw_text <- (-1); + let name = !tag in + let result = Raw_text.scan data start name in + emit scanner (Start (make_tag name (attributes !attrs))); + emit scanner (String result.Raw_text.text); + if result.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + for index = start to result.Raw_text.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Raw_text.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.declaration >= 0 then begin let start = scanner.declaration in scanner.declaration <- (-1); let result = Markup_declaration.scan data start in @@ -232,7 +243,7 @@ let run scanner = end else begin %%write exec; - if scanner.declaration >= 0 then () + if scanner.declaration >= 0 || scanner.raw_text >= 0 then () else if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true end diff --git a/src/lite/raw_text.ml b/src/lite/raw_text.ml new file mode 100644 index 0000000..9a2c08e --- /dev/null +++ b/src/lite/raw_text.ml @@ -0,0 +1,301 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* Port of the RCDATA, RAWTEXT, and script data tokenizer states of + src/baseline/html_tokenizer.ml (8.2.4.3, 8.2.4.5, 8.2.4.6, and + 8.2.4.11-8.2.4.43), operating on the normalized input string. [scan] is + given the index just after the '>' of the opening tag and the lowercase + element name, and consumes the element's raw content up to and including + its end tag, if any. *) + +type result = { text : string; had_end_tag : bool; next : int } + +let u_rep_utf_8 = "\xEF\xBF\xBD" + +let add buffer byte = + if byte = '\x00' then Buffer.add_string buffer u_rep_utf_8 + else Buffer.add_char buffer byte + +let is_whitespace = function '\t' | '\n' | '\x0C' | ' ' -> true | _ -> false +let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false + +let scan data start tag = + let length = String.length data in + let decode = match tag with "title" | "textarea" -> true | _ -> false in + let buffer = Buffer.create 256 in + let finish had_end_tag next = + let text = Buffer.contents buffer in + let text = if decode then Html_entity_decoder.decode text else text in + { text; had_end_tag; next } + in + let word_is first after word = + after - first = String.length word + && begin + let rec check offset = + offset >= String.length word + || Char.lowercase_ascii data.[first + offset] = word.[offset] + && check (offset + 1) + in + check 0 + end + in + (* End tag attributes are parsed only to find the terminating '>'; names + and values are discarded. *) + let rec before_attribute_name index = + if index >= length then None + else + match data.[index] with + | byte when is_whitespace byte -> before_attribute_name (index + 1) + | '/' -> self_closing_start_tag (index + 1) + | '>' -> Some (index + 1) + | _ -> attribute_name (index + 1) + and attribute_name index = + if index >= length then None + else + match data.[index] with + | byte when is_whitespace byte -> after_attribute_name (index + 1) + | '/' -> self_closing_start_tag (index + 1) + | '=' -> before_attribute_value (index + 1) + | '>' -> Some (index + 1) + | _ -> attribute_name (index + 1) + and after_attribute_name index = + if index >= length then None + else + match data.[index] with + | byte when is_whitespace byte -> after_attribute_name (index + 1) + | '/' -> self_closing_start_tag (index + 1) + | '=' -> before_attribute_value (index + 1) + | '>' -> Some (index + 1) + | _ -> attribute_name (index + 1) + and before_attribute_value index = + if index >= length then None + else + match data.[index] with + | byte when is_whitespace byte -> before_attribute_value (index + 1) + | ('"' | '\'') as quote -> attribute_value_quoted quote (index + 1) + | '>' -> Some (index + 1) + | _ -> attribute_value_unquoted (index + 1) + and attribute_value_quoted quote index = + if index >= length then None + else if data.[index] = quote then after_attribute_value_quoted (index + 1) + else attribute_value_quoted quote (index + 1) + and after_attribute_value_quoted index = + if index >= length then None + else + match data.[index] with + | byte when is_whitespace byte -> before_attribute_name (index + 1) + | '/' -> self_closing_start_tag (index + 1) + | '>' -> Some (index + 1) + | _ -> before_attribute_name index + and attribute_value_unquoted index = + if index >= length then None + else + match data.[index] with + | byte when is_whitespace byte -> before_attribute_name (index + 1) + | '>' -> Some (index + 1) + | _ -> attribute_value_unquoted (index + 1) + and self_closing_start_tag index = + if index >= length then None + else if data.[index] = '>' then Some (index + 1) + else before_attribute_name index + in + let finish_tag = function + | Some next -> finish true next + | None -> finish false length + in + let rec text index = + if index >= length then finish false index + else + match data.[index] with + | '<' -> text_less_than_sign index (index + 1) + | byte -> + add buffer byte; + text (index + 1) + and text_less_than_sign lt index = + if index < length && data.[index] = '/' then end_tag_open text lt (index + 1) + else begin + Buffer.add_char buffer '<'; + text index + end + and end_tag_open state lt index = + if index < length && is_letter data.[index] then + end_tag_name state lt (index + 1) + else begin + Buffer.add_string buffer "= length then dump () + else + match data.[index] with + | byte when is_whitespace byte && appropriate () -> + finish_tag (before_attribute_name (index + 1)) + | '/' when appropriate () -> + finish_tag (self_closing_start_tag (index + 1)) + | '>' when appropriate () -> finish true (index + 1) + | byte when is_letter byte -> end_tag_name state lt (index + 1) + | _ -> dump () + and script index = + if index >= length then finish false index + else + match data.[index] with + | '<' -> script_less_than_sign index (index + 1) + | byte -> + add buffer byte; + script (index + 1) + and script_less_than_sign lt index = + if index >= length then begin + Buffer.add_char buffer '<'; + script index + end + else + match data.[index] with + | '/' -> end_tag_open script lt (index + 1) + | '!' -> + Buffer.add_string buffer " + Buffer.add_char buffer '<'; + script index + and escape_start index = + if index < length && data.[index] = '-' then begin + Buffer.add_char buffer '-'; + escape_start_dash (index + 1) + end + else script index + and escape_start_dash index = + if index < length && data.[index] = '-' then begin + Buffer.add_char buffer '-'; + escaped_dash_dash (index + 1) + end + else script index + and escaped index = + if index >= length then finish false index + else + match data.[index] with + | '-' -> + Buffer.add_char buffer '-'; + escaped_dash (index + 1) + | '<' -> escaped_less_than_sign index (index + 1) + | byte -> + add buffer byte; + escaped (index + 1) + and escaped_dash index = + if index >= length then finish false index + else + match data.[index] with + | '-' -> + Buffer.add_char buffer '-'; + escaped_dash_dash (index + 1) + | '<' -> escaped_less_than_sign index (index + 1) + | byte -> + add buffer byte; + escaped (index + 1) + and escaped_dash_dash index = + if index >= length then finish false index + else + match data.[index] with + | '-' -> + Buffer.add_char buffer '-'; + escaped_dash_dash (index + 1) + | '<' -> escaped_less_than_sign index (index + 1) + | '>' -> + Buffer.add_char buffer '>'; + script (index + 1) + | byte -> + add buffer byte; + escaped (index + 1) + and escaped_less_than_sign lt index = + if index >= length then begin + Buffer.add_char buffer '<'; + escaped index + end + else + match data.[index] with + | '/' -> end_tag_open escaped lt (index + 1) + | byte when is_letter byte -> + Buffer.add_char buffer '<'; + Buffer.add_char buffer byte; + double_escape_start index (index + 1) + | _ -> + Buffer.add_char buffer '<'; + escaped index + and double_escape_start first index = + if index >= length then escaped index + else + match data.[index] with + | ('\t' | '\n' | '\x0C' | ' ' | '/' | '>') as byte -> + Buffer.add_char buffer byte; + if word_is first index "script" then double_escaped (index + 1) + else escaped (index + 1) + | byte when is_letter byte -> + Buffer.add_char buffer byte; + double_escape_start first (index + 1) + | _ -> escaped index + and double_escaped index = + if index >= length then finish false index + else + match data.[index] with + | '-' -> + Buffer.add_char buffer '-'; + double_escaped_dash (index + 1) + | '<' -> + Buffer.add_char buffer '<'; + double_escaped_less_than_sign (index + 1) + | byte -> + add buffer byte; + double_escaped (index + 1) + and double_escaped_dash index = + if index >= length then finish false index + else + match data.[index] with + | '-' -> + Buffer.add_char buffer '-'; + double_escaped_dash_dash (index + 1) + | '<' -> + Buffer.add_char buffer '<'; + double_escaped_less_than_sign (index + 1) + | byte -> + add buffer byte; + double_escaped (index + 1) + and double_escaped_dash_dash index = + if index >= length then finish false index + else + match data.[index] with + | '-' -> + Buffer.add_char buffer '-'; + double_escaped_dash_dash (index + 1) + | '<' -> + Buffer.add_char buffer '<'; + double_escaped_less_than_sign (index + 1) + | '>' -> + Buffer.add_char buffer '>'; + script (index + 1) + | byte -> + add buffer byte; + double_escaped (index + 1) + and double_escaped_less_than_sign index = + if index < length && data.[index] = '/' then begin + Buffer.add_char buffer '/'; + double_escape_end (index + 1) (index + 1) + end + else double_escaped index + and double_escape_end first index = + if index >= length then double_escaped index + else + match data.[index] with + | ('\t' | '\n' | '\x0C' | ' ' | '/' | '>') as byte -> + Buffer.add_char buffer byte; + if word_is first index "script" then escaped (index + 1) + else double_escaped (index + 1) + | byte when is_letter byte -> + Buffer.add_char buffer byte; + double_escape_end first (index + 1) + | _ -> double_escaped index + in + match tag with "script" -> script start | _ -> text start diff --git a/test/lite/dune b/test/lite/dune index 184defa..7a29e11 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -43,3 +43,8 @@ (alias runtest) (action (run %{exe:lite_fuzz_regression.exe}))) + +(executable + (name lite_dump_signals) + (modules lite_dump_signals) + (libraries lite_test_oracle markup markup.common markup.lite)) From c269f45ba85dc7e09d9560297479a6a70106a6c5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 17:46:45 +0000 Subject: [PATCH 057/109] fix: keep whitespace-only table text from String tokens like src/baseline --- src/lite/html_parser.ml | 5 ++++- test/lite/lite_baseline_regression.ml | 6 ++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index 76157b6..e5ea2d1 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -2117,7 +2117,10 @@ let parse ?depth_limit requested_context report tokens = reprocess (List.rev cs) else begin List.rev cs - |> List.iter (function l, Char c -> add_character l c | _ -> ()); + |> List.iter (function + | l, Char c -> add_character l c + | l, String s -> add_string l s + | _ -> ()); mode () end end diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 575a35f..9385c28 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -75,6 +75,12 @@ let () = agrees "leading bom" "\xEF\xBB\xBFa"; agrees "bom in text" "a\xEF\xBB\xBFb"; ]; + "table whitespace" + >::: [ + agrees "before colgroup" "\n\t
"; + agrees "between rows" + "
a
"; + ]; "attributes" >::: [ agrees "source order" "

x"; From 068b9e8874ab34c5708f7cc17b3e917a9fd6b5cd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 18:01:17 +0000 Subject: [PATCH 058/109] fix: parse start tag attributes with src/baseline tokenizer states --- src/lite/ragel_html_tokenizer.ml | 1886 +++++---------------------- src/lite/ragel_html_tokenizer.ml.rl | 107 +- src/lite/tag_attributes.ml | 139 ++ 3 files changed, 472 insertions(+), 1660 deletions(-) create mode 100644 src/lite/tag_attributes.ml diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 6279885..61a2f24 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -18,10 +18,8 @@ type t = { mark : int ref; mark_end : int ref; tag : string ref; - key : string ref; - attrs : (string * string) list ref; mutable declaration : int; - mutable raw_text : int; + mutable tag_scan : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -32,8 +30,7 @@ type t = { let decode = Html_entity_decoder.decode -(* [attrs] is accumulated in reverse source order; the first occurrence of a - name wins, like src/baseline. *) +(* The first occurrence of a name wins, like src/baseline. *) let attributes attrs = let rec dedupe seen = function | [] -> [] @@ -43,7 +40,7 @@ let attributes attrs = (name, Html_entity_decoder.decode_attribute value) :: dedupe (name :: seen) rest in - dedupe [] (List.rev attrs) + dedupe [] attrs let make_tag ?(self_closing = false) name attributes = { Token_tag.name; attributes; self_closing } @@ -89,39 +86,13 @@ let _htmlstream_trans_keys : int array = 122; 10; 10; - 0; - 62; - 0; - 122; - 0; - 122; - 0; - 122; - 0; - 62; - 10; - 60; - 0; - 62; - 0; + 9; 62; - 10; - 60; - 10; - 34; - 10; - 34; - 0; - 122; - 10; - 39; - 10; - 39; 0; 122; 10; 62; - 0; + 9; 62; 10; 62; @@ -132,64 +103,10 @@ let _htmlstream_trans_keys : int array = ] let _htmlstream_key_spans : int array = - Array.concat - [ - [| - 51; - 51; - 123; - 1; - 63; - 123; - 123; - 123; - 63; - 51; - 63; - 63; - 51; - 25; - 25; - 123; - 30; - 30; - 123; - 53; - 63; - 53; - 1; - |]; - ] + Array.concat [ [| 51; 51; 123; 1; 54; 123; 53; 54; 53; 1 |] ] let _htmlstream_index_offsets : int array = - Array.concat - [ - [| - 0; - 52; - 104; - 228; - 230; - 294; - 418; - 542; - 666; - 730; - 782; - 846; - 910; - 962; - 988; - 1014; - 1138; - 1169; - 1200; - 1324; - 1378; - 1442; - 1496; - |]; - ] + Array.concat [ [| 0; 52; 104; 228; 230; 285; 409; 463; 518; 572 |] ] let _htmlstream_indicies : int array = Array.concat @@ -426,37 +343,28 @@ let _htmlstream_indicies : int array = 12; 11; 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; 15; + 13; 14; 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; + 13; 14; 13; 13; @@ -472,7 +380,7 @@ let _htmlstream_indicies : int array = 13; 13; 13; - 16; + 14; 13; 13; 13; @@ -487,8 +395,56 @@ let _htmlstream_indicies : int array = 13; 13; 13; - 17; + 14; 13; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 17; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 16; + 18; + 18; + 16; 18; 18; 18; @@ -499,7 +455,13 @@ let _htmlstream_indicies : int array = 18; 18; 18; + 18; + 16; + 16; + 16; 19; + 16; + 16; 18; 18; 18; @@ -522,20 +484,43 @@ let _htmlstream_indicies : int array = 18; 18; 18; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 20; - 20; + 18; + 18; + 18; + 18; + 16; + 16; + 16; + 16; + 18; + 16; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 16; 21; 20; 20; @@ -548,23 +533,6 @@ let _htmlstream_indicies : int array = 20; 20; 20; - 6; - 6; - 6; - 22; - 6; - 6; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; 20; 20; 20; @@ -580,12 +548,6 @@ let _htmlstream_indicies : int array = 20; 20; 20; - 6; - 6; - 6; - 6; - 20; - 6; 20; 20; 20; @@ -611,8 +573,21 @@ let _htmlstream_indicies : int array = 20; 20; 20; + 22; 20; - 6; + 24; + 25; + 23; + 24; + 24; + 23; + 23; + 23; + 23; + 23; + 23; + 23; + 23; 23; 23; 23; @@ -638,6 +613,7 @@ let _htmlstream_indicies : int array = 23; 23; 23; + 24; 23; 23; 23; @@ -646,1243 +622,159 @@ let _htmlstream_indicies : int array = 23; 23; 23; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 25; - 25; - 26; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 6; - 6; - 27; + 23; + 23; + 23; + 23; + 23; + 23; + 26; + 23; 28; - 6; - 6; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 6; - 6; - 6; - 6; - 25; - 6; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 25; - 6; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 30; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 29; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 31; - 31; - 32; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 6; - 6; - 33; - 34; - 6; - 6; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 6; - 6; - 6; - 6; - 31; - 6; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 6; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 35; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 21; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 36; - 6; - 38; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 37; - 39; - 37; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 41; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 33; - 40; - 42; - 40; - 40; - 40; - 40; - 43; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 40; - 6; - 40; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 46; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 45; - 44; - 6; - 44; - 44; - 44; - 44; - 6; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 44; - 47; - 44; - 49; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 48; - 50; - 48; - 52; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 51; - 53; - 51; - 55; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 54; - 56; - 54; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 58; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 57; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 31; - 31; - 32; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 6; - 6; - 6; - 34; - 6; - 6; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 6; - 6; - 6; - 6; - 31; - 6; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 31; - 6; - 60; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 59; - 53; - 59; - 62; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 61; - 56; - 61; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 65; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 64; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 63; - 66; - 66; - 63; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 63; - 63; - 63; - 67; - 63; - 63; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 63; - 63; - 63; - 63; - 66; - 63; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 66; - 63; - 69; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 68; - 70; - 68; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 73; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 72; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 72; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 71; - 74; - 71; - 76; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 75; - 77; - 75; - 79; - 78; - 0; - |]; - ] - -let _htmlstream_trans_targs : int array = - Array.concat - [ - [| - 1; - 1; - 2; - 1; - 1; - 2; - 3; - 2; - 0; - 4; - 18; - 3; - 3; - 4; - 5; - 5; - 8; - 12; - 5; - 5; - 6; - 8; - 12; - 7; - 7; - 6; - 8; - 10; - 12; - 7; - 7; - 6; - 8; - 10; - 12; - 8; - 9; - 1; - 1; - 2; - 11; - 10; - 13; - 16; - 11; - 5; - 5; - 12; - 1; - 1; - 2; - 14; - 14; - 15; - 14; - 14; - 15; - 5; - 5; - 17; - 17; - 17; - 17; - 19; - 18; - 18; - 20; - 0; - 19; - 19; - 0; - 20; - 19; - 19; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 27; + 29; + 27; + 31; + 30; 0; - 21; - 21; - 22; - 22; - 22; |]; ] -let _htmlstream_trans_actions : int array = +let _htmlstream_trans_targs : int array = Array.concat [ [| + 1; 1; 2; - 0; + 1; + 1; + 2; + 3; + 2; 0; 4; - 3; 5; + 3; + 3; 4; + 1; + 1; 6; + 5; 7; - 8; 0; - 4; + 6; + 6; + 0; + 7; + 6; + 6; 0; + 8; + 8; 9; - 10; 9; 9; - 0; - 4; + |]; + ] + +let _htmlstream_trans_actions : int array = + Array.concat + [ + [| 1; + 2; 0; 0; - 11; - 12; - 0; - 13; - 11; - 13; - 0; - 4; - 14; - 15; - 0; - 15; 4; - 0; - 17; - 18; - 16; - 1; + 3; + 5; 4; - 0; - 0; - 0; - 19; - 20; - 19; - 22; - 23; - 21; + 6; 1; - 2; - 24; 0; - 4; - 25; - 15; - 26; - 1; - 2; 0; 4; - 27; 0; + 8; + 9; + 10; 4; 1; - 27; + 10; 0; 4; 0; 0; - 28; - 29; - 28; + 11; + 12; + 11; 0; 4; - 30; + 13; 0; 4; |]; ] let _htmlstream_eof_actions : int array = - Array.concat - [ - [| - 0; 3; 5; 0; 5; 5; 5; 5; 5; 16; 5; 5; 21; 5; 5; 5; 5; 5; 5; 5; 5; 0; 0; - |]; - ] + Array.concat [ [| 0; 3; 5; 0; 7; 5; 5; 5; 0; 0 |] ] let htmlstream_start : int = 0 let htmlstream_first_final : int = 0 let htmlstream_error : int = -1 -let htmlstream_en_garbage_tag : int = 21 +let htmlstream_en_garbage_tag : int = 8 let htmlstream_en_main : int = 0 type _htmlstream_state = { mutable keys : int; mutable trans : int } @@ -1908,10 +800,8 @@ let create data = mark = ref (-1); mark_end = ref (-1); tag = ref ""; - key = ref ""; - attrs = ref []; declaration = -1; - raw_text = -1; + tag_scan = -1; line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -1929,8 +819,6 @@ let run scanner = let mark = scanner.mark in let mark_end = scanner.mark_end in let tag = scanner.tag in - let key = scanner.key in - let attrs = scanner.attrs in pe := !eof; let pause () = if scanner.write >= buffer_capacity - maximum_transition_output && !p < !eof @@ -1947,18 +835,34 @@ let run scanner = mark_end := -1; text in - if scanner.raw_text >= 0 then begin - let start = scanner.raw_text in - scanner.raw_text <- -1; + if scanner.tag_scan >= 0 then begin + let start = scanner.tag_scan in + scanner.tag_scan <- -1; let name = !tag in - let result = Raw_text.scan data start name in - emit scanner (Start (make_tag name (attributes !attrs))); - emit scanner (String result.Raw_text.text); - if result.Raw_text.had_end_tag then emit scanner (End (make_tag name [])); - for index = start to result.Raw_text.next - 1 do + let result = Tag_attributes.scan data start in + let next = + if not result.Tag_attributes.ok then !eof + else begin + let attrs = attributes result.Tag_attributes.attributes in + let self_closing = result.Tag_attributes.self_closing in + match name with + | "script" | "style" | "title" | "textarea" -> + let after_tag = result.Tag_attributes.next in + let body = Raw_text.scan data after_tag name in + emit scanner (Start (make_tag ~self_closing name attrs)); + emit scanner (String body.Raw_text.text); + if body.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + body.Raw_text.next + | _ -> + emit scanner (Start (make_tag ~self_closing name attrs)); + result.Tag_attributes.next + end + in + for index = start to next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 done; - p := result.Raw_text.next; + p := next; cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true end @@ -2014,18 +918,7 @@ let run scanner = mark := !p end; () - | 25 -> - begin - mark_end := !p - end; - () - | 9 -> - begin - tag := String.lowercase_ascii @@ sub (); - attrs := [] - end; - () - | 28 -> + | 11 -> begin let name = String.lowercase_ascii @@ sub () in emit scanner (End (make_tag name [])); @@ -2038,65 +931,25 @@ let run scanner = pause () end; () - | 11 -> - begin - key := String.lowercase_ascii @@ sub () - end; - () - | 15 -> + | 13 -> begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - () - | 21 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause () - end; - () - | 16 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner - (Start - (make_tag ~self_closing:true name (attributes !attrs))); - pause () - end; - () - | 30 -> - begin match !tag with - | "" -> begin + begin cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p + 1; - pe := !p + 1 - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause (); - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end + end; + () + | 6 -> + begin + scanner.declaration <- !p; + pe := !p + 1 end; () | 5 -> begin p.contents <- p.contents - 1; begin - cs.contents <- 21; + cs.contents <- 8; if true then raise_notrace Goto_again_htmlstream end end; @@ -2106,20 +959,7 @@ let run scanner = scanner.line <- scanner.line + 1 end; () - | 8 -> - begin - tag := "" - end; - () - | 24 -> - begin - mark := !p - end; - begin - mark_end := !p - end; - () - | 27 -> + | 10 -> begin mark := !p end; @@ -2137,24 +977,7 @@ let run scanner = scanner.line <- scanner.line + 1 end; () - | 19 -> - begin - mark_end := !p - end; - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - () - | 10 -> - begin - tag := String.lowercase_ascii @@ sub (); - attrs := [] - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 29 -> + | 12 -> begin let name = String.lowercase_ascii @@ sub () in emit scanner (End (make_tag name [])); @@ -2164,129 +987,24 @@ let run scanner = scanner.line <- scanner.line + 1 end; () - | 13 -> - begin - key := String.lowercase_ascii @@ sub () - end; - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - () - | 12 -> - begin - key := String.lowercase_ascii @@ sub () - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 14 -> - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - begin - mark := !p - end; - () - | 26 -> - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 22 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause () - end; - begin - mark := !p - end; - () - | 17 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner - (Start - (make_tag ~self_closing:true name (attributes !attrs))); - pause () - end; - begin - mark := !p - end; - () - | 7 -> + | 8 -> begin - tag := "" + tag := String.lowercase_ascii @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 end; begin mark := !p end; () - | 6 -> - begin - tag := "" - end; + | 9 -> begin - scanner.declaration <- !p; + tag := String.lowercase_ascii @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; pe := !p + 1 end; - () - | 20 -> - begin - mark_end := !p - end; - begin - attrs := (!key, if !mark < 0 then "" else sub ()) :: !attrs - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 23 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause () - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 18 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner - (Start - (make_tag ~self_closing:true name (attributes !attrs))); - pause () - end; begin mark := !p end; @@ -2312,37 +1030,19 @@ let run scanner = pause () end; () - | 21 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause () - end; - () - | 16 -> - begin match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - | name -> - emit scanner - (Start - (make_tag ~self_closing:true name (attributes !attrs))); - pause () + | 7 -> + begin + tag := String.lowercase_ascii @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 end; () | 5 -> begin p.contents <- p.contents - 1; begin - cs.contents <- 21; + cs.contents <- 8; if true then raise_notrace Goto_again_htmlstream end end; @@ -2357,7 +1057,7 @@ let run scanner = do_start () end; - if scanner.declaration >= 0 || scanner.raw_text >= 0 then () + if scanner.declaration >= 0 || scanner.tag_scan >= 0 then () else if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index b8f647f..53da821 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -21,10 +21,8 @@ type t = { mark : int ref; mark_end : int ref; tag : string ref; - key : string ref; - attrs : (string * string) list ref; mutable declaration : int; - mutable raw_text : int; + mutable tag_scan : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -35,8 +33,7 @@ type t = { let decode = Html_entity_decoder.decode -(* [attrs] is accumulated in reverse source order; the first occurrence of a - name wins, like src/baseline. *) +(* The first occurrence of a name wins, like src/baseline. *) let attributes attrs = let rec dedupe seen = function | [] -> [] @@ -46,7 +43,7 @@ let attributes attrs = (name, Html_entity_decoder.decode_attribute value) :: dedupe (name :: seen) rest in - dedupe [] (List.rev attrs) + dedupe [] attrs let make_tag ?(self_closing = false) name attributes = {Token_tag.name; attributes; self_closing} @@ -86,7 +83,6 @@ let emit_text scanner text = action mark { mark := !p } action mark_end { mark_end := !p } - action tag { tag := String.lowercase_ascii @@ sub (); attrs := []; } action close_tag { let name = String.lowercase_ascii @@ sub () in emit scanner (End (make_tag name [])); @@ -96,42 +92,13 @@ let emit_text scanner text = emit_text scanner (decode (sub ())); pause (); } - action key { key := String.lowercase_ascii @@ sub () } - action store_attr { attrs := (!key, if !mark < 0 then "" else sub()) :: !attrs } - action tag_done { - match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - fhold; - pe := !p + 1; - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause (); - } - action tag_done_2 { - match !tag with - | "" -> () - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p; - fhold; - pe := !p + 1; - | name -> - emit scanner - (Start (make_tag ~self_closing:true name (attributes !attrs))); - pause (); - } - action garbage_tag_done { - match !tag with - | "" -> fgoto main; - | "script" | "style" | "title" | "textarea" -> - scanner.raw_text <- !p + 1; - pe := !p + 1; - | name -> - emit scanner (Start (make_tag name (attributes !attrs))); - pause (); - fgoto main; + action tag_start { + tag := String.lowercase_ascii @@ sub (); + scanner.tag_scan <- !p; + fhold; + pe := !p + 1; } + action garbage_tag_done { fgoto main; } action markup_declaration { scanner.declaration <- !p; pe := !p + 1; } action garbage_tag { fhold; fgoto garbage_tag; } @@ -139,23 +106,18 @@ let emit_text scanner text = count_newlines = ('\n' >{ scanner.line <- scanner.line + 1 } | ^'\n'+)**; wsp = 0..32; + html_ws = 0x09 | 0x0A | 0x0C | 0x0D | 0x20; ident = alnum | '-' | [_:.] ; - tag_name = ident ( any - ( wsp | '/' | '>' ) )*; + tag_name = ident ( any - ( html_ws | '/' | '>' ) )*; garbage_tag := (count_newlines | ^'>'* '>' @garbage_tag_done); - literal = - ("'" ^"'"* >mark %mark_end "'" | - '"' ^'"'* >mark %mark_end '"' | - ^(wsp|'"'|"'"|'>')+ >mark %mark_end); - tag_attrs = (wsp+ | ident+ >mark %key wsp* ('=' wsp* literal)? %store_attr )**; close_tag = '/' wsp* tag_name? >mark %close_tag <: ^'>'* '>'; - open_tag = tag_name >mark %tag <: wsp* tag_attrs - ('/' wsp* '>' %tag_done_2 | '>' %tag_done); + open_tag = tag_name >mark %tag_start; declaration = ('!'|'?') @markup_declaration; tag = '<' wsp* <: (close_tag | open_tag | declaration) - @lerr(garbage_tag) >{ tag := "" }; + @lerr(garbage_tag); main := (((tag | ^'<' >mark ^'<'* %text ) )** | count_newlines); write data; @@ -173,10 +135,8 @@ let create data = mark = ref (-1); mark_end = ref (-1); tag = ref ""; - key = ref ""; - attrs = ref []; declaration = (-1); - raw_text = (-1); + tag_scan = (-1); line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -193,8 +153,6 @@ let run scanner = let mark = scanner.mark in let mark_end = scanner.mark_end in let tag = scanner.tag in - let key = scanner.key in - let attrs = scanner.attrs in pe := !eof; let pause () = if scanner.write >= buffer_capacity - maximum_transition_output && @@ -213,19 +171,34 @@ let run scanner = mark_end := -1; text in - if scanner.raw_text >= 0 then begin - let start = scanner.raw_text in - scanner.raw_text <- (-1); + if scanner.tag_scan >= 0 then begin + let start = scanner.tag_scan in + scanner.tag_scan <- (-1); let name = !tag in - let result = Raw_text.scan data start name in - emit scanner (Start (make_tag name (attributes !attrs))); - emit scanner (String result.Raw_text.text); - if result.Raw_text.had_end_tag then - emit scanner (End (make_tag name [])); - for index = start to result.Raw_text.next - 1 do + let result = Tag_attributes.scan data start in + let next = + if not result.Tag_attributes.ok then !eof + else begin + let attrs = attributes result.Tag_attributes.attributes in + let self_closing = result.Tag_attributes.self_closing in + match name with + | "script" | "style" | "title" | "textarea" -> + let after_tag = result.Tag_attributes.next in + let body = Raw_text.scan data after_tag name in + emit scanner (Start (make_tag ~self_closing name attrs)); + emit scanner (String body.Raw_text.text); + if body.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + body.Raw_text.next + | _ -> + emit scanner (Start (make_tag ~self_closing name attrs)); + result.Tag_attributes.next + end + in + for index = start to next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 done; - p := result.Raw_text.next; + p := next; cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true end @@ -243,7 +216,7 @@ let run scanner = end else begin %%write exec; - if scanner.declaration >= 0 || scanner.raw_text >= 0 then () + if scanner.declaration >= 0 || scanner.tag_scan >= 0 then () else if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true end diff --git a/src/lite/tag_attributes.ml b/src/lite/tag_attributes.ml new file mode 100644 index 0000000..3ec0a87 --- /dev/null +++ b/src/lite/tag_attributes.ml @@ -0,0 +1,139 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +(* Port of the attribute tokenizer states of src/baseline/html_tokenizer.ml + (8.2.4.34-43 plus the self-closing state). [scan] is given the index of + the first byte after a start tag's name and returns the attributes in + source order with raw (undecoded) values, whether the tag is + self-closing, and the index after the closing '>'. [ok] is false when + the input ends inside the tag, in which case no token is emitted. *) + +type result = { + attributes : (string * string) list; + self_closing : bool; + next : int; + ok : bool; +} + +let u_rep_utf_8 = "\xEF\xBF\xBD" + +let add buffer byte = + if byte = '\x00' then Buffer.add_string buffer u_rep_utf_8 + else Buffer.add_char buffer byte + +let add_lowercase buffer byte = + if byte = '\x00' then Buffer.add_string buffer u_rep_utf_8 + else Buffer.add_char buffer (Char.lowercase_ascii byte) + +let is_whitespace = function '\t' | '\n' | '\x0C' | ' ' -> true | _ -> false + +let scan data start = + let length = String.length data in + let attributes = ref [] in + let name = Buffer.create 16 in + let value = Buffer.create 32 in + let commit () = + if Buffer.length name > 0 then + attributes := (Buffer.contents name, Buffer.contents value) :: !attributes; + Buffer.clear name; + Buffer.clear value + in + let finish ?(self_closing = false) index = + commit (); + { attributes = List.rev !attributes; self_closing; next = index; ok = true } + in + let eof index = + { attributes = []; self_closing = false; next = index; ok = false } + in + let rec before_name index = + if index >= length then eof index + else + let byte = data.[index] in + if is_whitespace byte then before_name (index + 1) + else if byte = '/' then self_closing_start (index + 1) + else if byte = '>' then finish (index + 1) + else begin + add_lowercase name byte; + in_name (index + 1) + end + and in_name index = + if index >= length then eof index + else + let byte = data.[index] in + if is_whitespace byte then after_name (index + 1) + else if byte = '/' then begin + commit (); + self_closing_start (index + 1) + end + else if byte = '=' then before_value (index + 1) + else if byte = '>' then finish (index + 1) + else begin + add_lowercase name byte; + in_name (index + 1) + end + and after_name index = + if index >= length then eof index + else + let byte = data.[index] in + if is_whitespace byte then after_name (index + 1) + else if byte = '/' then begin + commit (); + self_closing_start (index + 1) + end + else if byte = '=' then before_value (index + 1) + else if byte = '>' then finish (index + 1) + else begin + commit (); + add_lowercase name byte; + in_name (index + 1) + end + and before_value index = + if index >= length then eof index + else + let byte = data.[index] in + if is_whitespace byte then before_value (index + 1) + else if byte = '"' || byte = '\'' then quoted byte (index + 1) + else if byte = '>' then finish (index + 1) + else begin + add value byte; + unquoted (index + 1) + end + and quoted quote index = + if index >= length then eof index + else + let byte = data.[index] in + if byte = quote then begin + commit (); + after_quoted (index + 1) + end + else begin + add value byte; + quoted quote (index + 1) + end + and unquoted index = + if index >= length then eof index + else + let byte = data.[index] in + if is_whitespace byte then begin + commit (); + before_name (index + 1) + end + else if byte = '>' then finish (index + 1) + else begin + add value byte; + unquoted (index + 1) + end + and after_quoted index = + if index >= length then eof index + else + let byte = data.[index] in + if is_whitespace byte then before_name (index + 1) + else if byte = '/' then self_closing_start (index + 1) + else if byte = '>' then finish (index + 1) + else before_name index + and self_closing_start index = + if index >= length then eof index + else if data.[index] = '>' then finish ~self_closing:true (index + 1) + else before_name index + in + before_name start From 73071326c1f13bacd6ce75c85828083240445fa8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Aug 2026 18:43:59 +0000 Subject: [PATCH 059/109] fix: honor tree-builder tokenizer state feedback like src/baseline --- src/lite/html_parser.ml | 34 +- src/lite/ragel_html_tokenizer.ml | 936 ++++++++++++-------------- src/lite/ragel_html_tokenizer.ml.rl | 186 +++-- src/lite/raw_text.ml | 8 + test/lite/lite_baseline_regression.ml | 22 + 5 files changed, 616 insertions(+), 570 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index e5ea2d1..e8d7128 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -987,7 +987,9 @@ let parse ?depth_limit requested_context report tokens = let tokenizer_state = ref Data in let token_location = Token_source.location () in let next_token tokens = - let token = Token_source.next tokens !tokenizer_state token_location in + let state = !tokenizer_state in + if state <> Data then tokenizer_state := Data; + let token = Token_source.next tokens state token_location in ((token_location.line, token_location.column), token) in let push = Token_source.push in @@ -997,6 +999,23 @@ let parse ?depth_limit requested_context report tokens = let ended = ref (fun _ -> ()) in let output = ref (fun _ -> ()) in + let remove_nulls s = + if String.contains s '\x00' then + String.concat "" (String.split_on_char '\x00' s) + else s + in + let replace_nulls s = + if String.contains s '\x00' then begin + let buffer = Buffer.create (String.length s + 8) in + String.iter + (fun byte -> + if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" + else Buffer.add_char buffer byte) + s; + Buffer.contents buffer + end + else s + in let report_if = Error.report_if report in let unmatched_end_tag l name k = report l (`Unmatched_end_tag name) !throw k @@ -1555,6 +1574,7 @@ let parse ?depth_limit requested_context report tokens = and in_body_mode_rules context_name mode = function | l, Char 0 -> report l (`Bad_token ("U+0000", "body", "null")) !throw mode | l, String s -> + let s = remove_nulls s in reconstruct_active_formatting_elements (fun () -> add_string l s; if not @@ is_whitespace_only s then frameset_ok := false; @@ -2103,6 +2123,12 @@ let parse ?depth_limit requested_context report tokens = | (_, Char (0x0009 | 0x000A | 0x000C | 0x000D | 0x0020)) as v -> in_table_text_mode only_space (v :: cs) mode | (_, Char _) as v -> in_table_text_mode false (v :: cs) mode + | l, String s when String.contains s '\x00' -> + let s = remove_nulls s in + let v = (l, String s) in + if is_whitespace_only s then + in_table_text_mode only_space (v :: cs) mode + else in_table_text_mode false (v :: cs) mode | (_, String s) as v when is_whitespace_only s -> in_table_text_mode only_space (v :: cs) mode | (_, String _) as v -> in_table_text_mode false (v :: cs) mode @@ -2361,7 +2387,7 @@ let parse ?depth_limit requested_context report tokens = add_character l c; mode () | l, String s -> - add_string l s; + add_string l (remove_nulls s); mode () | l, Comment s -> emit l (`Comment s) mode | l, Doctype _ -> @@ -2631,8 +2657,8 @@ let parse ?depth_limit requested_context report tokens = add_character l u_rep; mode ()) | l, String s -> - add_string l s; - if not @@ is_whitespace_only s then frameset_ok := false; + add_string l (replace_nulls s); + if not @@ is_whitespace_only (remove_nulls s) then frameset_ok := false; mode () | l, Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> add_character l c; diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 61a2f24..dde2a4c 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -16,10 +16,12 @@ type t = { pe : int ref; eof : int ref; mark : int ref; - mark_end : int ref; tag : string ref; + mutable last_start_tag : string; mutable declaration : int; + mutable bogus : int; mutable tag_scan : int; + mutable end_scan : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -45,6 +47,19 @@ let attributes attrs = let make_tag ?(self_closing = false) name attributes = { Token_tag.name; attributes; self_closing } +let normalize_name text = + let text = String.lowercase_ascii text in + if not (String.contains text '\x00') then text + else begin + let buffer = Buffer.create (String.length text + 8) in + String.iter + (fun byte -> + if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" + else Buffer.add_char buffer byte) + text; + Buffer.contents buffer + end + let buffer_capacity = 128 let maximum_transition_output = 3 @@ -53,8 +68,6 @@ let emit scanner token = scanner.lines.(scanner.write) <- scanner.line; scanner.write <- scanner.write + 1 -let emit_many scanner tokens = List.iter (emit scanner) tokens - (* The tree builder treats a leading whitespace run differently from the rest of a text run in several insertion modes; src/baseline gets this for free from per-character tokens. *) @@ -75,38 +88,13 @@ let emit_text scanner text = end let _htmlstream_trans_keys : int array = - Array.concat - [ - [| - 10; - 60; - 10; - 60; - 0; - 122; - 10; - 10; - 9; - 62; - 0; - 122; - 10; - 62; - 9; - 62; - 10; - 62; - 10; - 10; - 0; - |]; - ] + Array.concat [ [| 10; 60; 10; 60; 10; 122; 10; 122; 9; 62; 9; 62; 0 |] ] let _htmlstream_key_spans : int array = - Array.concat [ [| 51; 51; 123; 1; 54; 123; 53; 54; 53; 1 |] ] + Array.concat [ [| 51; 51; 113; 113; 54; 54 |] ] let _htmlstream_index_offsets : int array = - Array.concat [ [| 0; 52; 104; 228; 230; 285; 409; 463; 518; 572 |] ] + Array.concat [ [| 0; 52; 104; 218; 332; 387 |] ] let _htmlstream_indicies : int array = Array.concat @@ -216,40 +204,7 @@ let _htmlstream_indicies : int array = 3; 5; 3; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; 7; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 2; - 8; 6; 6; 6; @@ -261,142 +216,49 @@ let _htmlstream_indicies : int array = 6; 6; 6; - 9; - 9; - 10; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; + 6; + 6; + 6; + 6; + 6; + 6; + 6; 6; 6; 6; 6; 8; 6; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; 6; 6; 6; 6; - 9; 6; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; - 9; + 6; + 6; + 6; + 6; + 6; + 6; + 6; 9; 6; - 12; - 11; - 14; - 15; - 13; - 14; - 14; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 14; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 14; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 13; - 14; - 13; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 8; + 6; 10; 10; 10; @@ -407,7 +269,6 @@ let _htmlstream_indicies : int array = 10; 10; 10; - 17; 10; 10; 10; @@ -424,50 +285,213 @@ let _htmlstream_indicies : int array = 10; 10; 10; + 6; + 6; + 6; + 6; + 6; + 6; 10; 10; 10; 10; 10; 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 6; + 12; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 13; + 11; + 11; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 11; + 11; + 11; + 11; + 11; + 11; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 11; 16; + 17; + 15; 16; 16; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; 16; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; 16; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; 16; - 16; - 16; - 16; - 16; - 16; - 16; - 18; - 18; - 16; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 16; - 16; - 16; + 15; 19; - 16; - 16; - 18; - 18; - 18; - 18; - 18; + 20; 18; + 19; + 19; 18; 18; 18; @@ -486,14 +510,10 @@ let _htmlstream_indicies : int array = 18; 18; 18; + 19; 18; 18; - 16; - 16; - 16; - 16; 18; - 16; 18; 18; 18; @@ -505,6 +525,7 @@ let _htmlstream_indicies : int array = 18; 18; 18; + 19; 18; 18; 18; @@ -519,262 +540,28 @@ let _htmlstream_indicies : int array = 18; 18; 18; + 19; 18; - 16; - 21; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 20; - 22; - 20; - 24; - 25; - 23; - 24; - 24; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 24; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 24; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 23; - 26; - 23; - 28; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 27; - 29; - 27; - 31; - 30; 0; |]; ] let _htmlstream_trans_targs : int array = Array.concat - [ - [| - 1; - 1; - 2; - 1; - 1; - 2; - 3; - 2; - 0; - 4; - 5; - 3; - 3; - 4; - 1; - 1; - 6; - 5; - 7; - 0; - 6; - 6; - 0; - 7; - 6; - 6; - 0; - 8; - 8; - 9; - 9; - 9; - |]; - ] + [ [| 1; 1; 2; 1; 1; 2; 0; 0; 0; 3; 5; 0; 0; 0; 4; 4; 1; 1; 5; 1; 1 |] ] let _htmlstream_trans_actions : int array = Array.concat [ - [| - 1; - 2; - 0; - 0; - 4; - 3; - 5; - 4; - 6; - 1; - 0; - 0; - 4; - 0; - 8; - 9; - 10; - 4; - 1; - 10; - 0; - 4; - 0; - 0; - 11; - 12; - 11; - 0; - 4; - 13; - 0; - 4; - |]; + [| 1; 2; 0; 0; 4; 3; 6; 7; 8; 0; 1; 10; 11; 0; 1; 0; 13; 14; 0; 16; 17 |]; ] let _htmlstream_eof_actions : int array = - Array.concat [ [| 0; 3; 5; 0; 7; 5; 5; 5; 0; 0 |] ] + Array.concat [ [| 0; 3; 5; 9; 12; 15 |] ] let htmlstream_start : int = 0 let htmlstream_first_final : int = 0 let htmlstream_error : int = -1 -let htmlstream_en_garbage_tag : int = 8 let htmlstream_en_main : int = 0 type _htmlstream_state = { mutable keys : int; mutable trans : int } @@ -798,10 +585,12 @@ let create data = pe = ref length; eof = ref length; mark = ref (-1); - mark_end = ref (-1); tag = ref ""; + last_start_tag = ""; declaration = -1; + bogus = -1; tag_scan = -1; + end_scan = -1; line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -817,22 +606,16 @@ let run scanner = let pe = scanner.pe in let eof = scanner.eof in let mark = scanner.mark in - let mark_end = scanner.mark_end in let tag = scanner.tag in pe := !eof; let pause () = if scanner.write >= buffer_capacity - maximum_transition_output && !p < !eof then pe := !p + 1 in - let substr = String.sub in let sub () = assert (!mark >= 0); - if !mark_end < 0 then mark_end := !p; - let text = - if !mark_end <= !mark then "" else substr data !mark (!mark_end - !mark) - in + let text = if !p <= !mark then "" else String.sub data !mark (!p - !mark) in mark := -1; - mark_end := -1; text in if scanner.tag_scan >= 0 then begin @@ -845,27 +628,54 @@ let run scanner = else begin let attrs = attributes result.Tag_attributes.attributes in let self_closing = result.Tag_attributes.self_closing in - match name with - | "script" | "style" | "title" | "textarea" -> - let after_tag = result.Tag_attributes.next in - let body = Raw_text.scan data after_tag name in - emit scanner (Start (make_tag ~self_closing name attrs)); - emit scanner (String body.Raw_text.text); - if body.Raw_text.had_end_tag then - emit scanner (End (make_tag name [])); - body.Raw_text.next - | _ -> - emit scanner (Start (make_tag ~self_closing name attrs)); - result.Tag_attributes.next + scanner.last_start_tag <- name; + emit scanner (Start (make_tag ~self_closing name attrs)); + result.Tag_attributes.next end in - for index = start to next - 1 do + for index = start + 1 to next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.end_scan >= 0 then begin + let start = scanner.end_scan in + scanner.end_scan <- -1; + let name = !tag in + let result = Tag_attributes.scan data start in + if result.Tag_attributes.ok then emit scanner (End (make_tag name [])); + let next = + if result.Tag_attributes.ok then result.Tag_attributes.next else !eof + in + for index = start + 1 to next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 done; p := next; cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true end + else if scanner.bogus >= 0 then begin + let start = scanner.bogus in + scanner.bogus <- -1; + (* The consumed character is a codepoint, not a byte. *) + let width = + if data.[start] < '\x80' then 1 + else if data.[start] < '\xE0' then 2 + else if data.[start] < '\xF0' then 3 + else 4 + in + let start = min (start + width) !eof in + let result = Markup_declaration.bogus_comment data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end else if scanner.declaration >= 0 then begin let start = scanner.declaration in scanner.declaration <- -1; @@ -918,38 +728,31 @@ let run scanner = mark := !p end; () - | 11 -> - begin - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause () - end; - () | 3 -> begin emit_text scanner (decode (sub ())); pause () end; () - | 13 -> + | 8 -> begin - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end + scanner.declaration <- !p; + pe := !p + 1 end; () - | 6 -> + | 10 -> begin - scanner.declaration <- !p; + scanner.bogus <- !p; pe := !p + 1 end; () - | 5 -> + | 6 -> begin + emit scanner (String "<"); + pause (); p.contents <- p.contents - 1; begin - cs.contents <- 8; + cs.contents <- 0; if true then raise_notrace Goto_again_htmlstream end end; @@ -959,48 +762,76 @@ let run scanner = scanner.line <- scanner.line + 1 end; () - | 10 -> + | 2 -> begin mark := !p end; begin - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause () + scanner.line <- scanner.line + 1 end; () - | 2 -> + | 13 -> + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + begin + mark := !p + end; + () + | 16 -> + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; begin mark := !p end; + () + | 11 -> + begin + scanner.bogus <- !p; + pe := !p + 1 + end; begin scanner.line <- scanner.line + 1 end; () - | 12 -> + | 7 -> begin - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause () + emit scanner (String "<"); + pause (); + p.contents <- p.contents - 1; + begin + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream + end end; begin scanner.line <- scanner.line + 1 end; () - | 8 -> + | 14 -> begin - tag := String.lowercase_ascii @@ sub (); - scanner.tag_scan <- !p; + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; p.contents <- p.contents - 1; pe := !p + 1 end; begin mark := !p end; + begin + scanner.line <- scanner.line + 1 + end; () - | 9 -> + | 17 -> begin - tag := String.lowercase_ascii @@ sub (); + tag := normalize_name @@ sub (); scanner.tag_scan <- !p; p.contents <- p.contents - 1; pe := !p + 1 @@ -1024,15 +855,23 @@ let run scanner = if p.contents = eof.contents then begin try begin match _htmlstream_eof_actions.(cs.contents) with + | 12 -> + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + () | 3 -> begin emit_text scanner (decode (sub ())); pause () end; () - | 7 -> + | 15 -> begin - tag := String.lowercase_ascii @@ sub (); + tag := normalize_name @@ sub (); scanner.tag_scan <- !p; p.contents <- p.contents - 1; pe := !p + 1 @@ -1040,11 +879,13 @@ let run scanner = () | 5 -> begin - p.contents <- p.contents - 1; - begin - cs.contents <- 8; - if true then raise_notrace Goto_again_htmlstream - end + emit scanner (String "<") + end; + () + | 9 -> + begin + emit scanner (String "<"); + emit scanner (String "/") end; () | _ -> () @@ -1057,12 +898,57 @@ let run scanner = do_start () end; - if scanner.declaration >= 0 || scanner.tag_scan >= 0 then () + if + scanner.declaration >= 0 || scanner.bogus >= 0 || scanner.tag_scan >= 0 + || scanner.end_scan >= 0 + then () else if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true end -let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = +(* The tree builder requested a non-Data state for the next scan; the last + start tag emitted is the appropriate end tag. In fragment parsing no start + tag has been seen, so no end tag ever matches. *) +let scan_raw_state scanner state = + let data = scanner.data in + let start = !(scanner.p) in + if start >= !(scanner.eof) then scanner.finished <- true + else begin + let next_index = + match (state : Html_tokenizer.state) with + | PLAINTEXT -> + let body = Raw_text.plaintext data start in + emit scanner (String body.Raw_text.text); + body.Raw_text.next + | _ -> + let name = scanner.last_start_tag in + if name = "" then begin + let body = Raw_text.plaintext data start in + let text = + match (state : Html_tokenizer.state) with + | RCDATA -> decode body.Raw_text.text + | _ -> body.Raw_text.text + in + emit scanner (String text); + body.Raw_text.next + end + else begin + let body = Raw_text.scan data start name in + emit scanner (String body.Raw_text.text); + if body.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + body.Raw_text.next + end + in + for index = start to next_index - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + scanner.p := next_index; + scanner.cs := htmlstream_en_main; + if next_index >= !(scanner.eof) then scanner.finished <- true + end + +let rec next scanner (state : Html_tokenizer.state) (location : location_out) = if scanner.read < scanner.write then begin let index = scanner.read in let token = scanner.tokens.(index) in @@ -1077,9 +963,15 @@ let rec next scanner (_state : Html_tokenizer.state) (location : location_out) = location.column <- -1; EOF end + else if state <> Data then begin + scanner.read <- 0; + scanner.write <- 0; + scan_raw_state scanner state; + next scanner Data location + end else begin scanner.read <- 0; scanner.write <- 0; run scanner; - next scanner _state location + next scanner state location end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 53da821..41f6c6c 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -19,10 +19,12 @@ type t = { pe : int ref; eof : int ref; mark : int ref; - mark_end : int ref; tag : string ref; + mutable last_start_tag : string; mutable declaration : int; + mutable bogus : int; mutable tag_scan : int; + mutable end_scan : int; mutable line : int; tokens : Html_tokenizer.token array; lines : int array; @@ -48,6 +50,19 @@ let attributes attrs = let make_tag ?(self_closing = false) name attributes = {Token_tag.name; attributes; self_closing} +let normalize_name text = + let text = String.lowercase_ascii text in + if not (String.contains text '\x00') then text + else begin + let buffer = Buffer.create (String.length text + 8) in + String.iter + (fun byte -> + if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" + else Buffer.add_char buffer byte) + text; + Buffer.contents buffer + end + let buffer_capacity = 128 let maximum_transition_output = 3 @@ -56,9 +71,6 @@ let emit scanner token = scanner.lines.(scanner.write) <- scanner.line; scanner.write <- scanner.write + 1 -let emit_many scanner tokens = - List.iter (emit scanner) tokens - (* The tree builder treats a leading whitespace run differently from the rest of a text run in several insertion modes; src/baseline gets this for free from per-character tokens. *) @@ -82,42 +94,52 @@ let emit_text scanner text = machine htmlstream; action mark { mark := !p } - action mark_end { mark_end := !p } action close_tag { - let name = String.lowercase_ascii @@ sub () in - emit scanner (End (make_tag name [])); - pause (); + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + fhold; + pe := !p + 1; } action text { emit_text scanner (decode (sub ())); pause (); } action tag_start { - tag := String.lowercase_ascii @@ sub (); + tag := normalize_name @@ sub (); scanner.tag_scan <- !p; fhold; pe := !p + 1; } - action garbage_tag_done { fgoto main; } action markup_declaration { scanner.declaration <- !p; pe := !p + 1; } - - action garbage_tag { fhold; fgoto garbage_tag; } + action bogus_close { scanner.bogus <- !p; pe := !p + 1; } + action lt_text { + emit scanner (String "<"); + pause (); + fhold; + fgoto main; + } + action eof_lt { emit scanner (String "<") } + action eof_lt_slash { + emit scanner (String "<"); + emit scanner (String "/") + } count_newlines = ('\n' >{ scanner.line <- scanner.line + 1 } | ^'\n'+)**; - wsp = 0..32; html_ws = 0x09 | 0x0A | 0x0C | 0x0D | 0x20; - ident = alnum | '-' | [_:.] ; - tag_name = ident ( any - ( html_ws | '/' | '>' ) )*; - - garbage_tag := (count_newlines | ^'>'* '>' @garbage_tag_done); + tag_name = alpha ( any - ( html_ws | '/' | '>' ) )*; - close_tag = '/' wsp* tag_name? >mark %close_tag <: ^'>'* '>'; + close_tag = tag_name >mark %close_tag; open_tag = tag_name >mark %tag_start; declaration = ('!'|'?') @markup_declaration; - tag = '<' wsp* <: - (close_tag | open_tag | declaration) - @lerr(garbage_tag); + tag = ('<' %/eof_lt) ( + ('/' %/eof_lt_slash) + ( close_tag + | '>' + | ( any - ( alpha | '>' ) ) @bogus_close ) + | open_tag + | declaration + | ( any - ( alpha | '/' | '!' | '?' ) ) @lt_text ); main := (((tag | ^'<' >mark ^'<'* %text ) )** | count_newlines); write data; @@ -133,10 +155,12 @@ let create data = pe = ref length; eof = ref length; mark = ref (-1); - mark_end = ref (-1); tag = ref ""; + last_start_tag = ""; declaration = (-1); + bogus = (-1); tag_scan = (-1); + end_scan = (-1); line = 1; tokens = Array.make buffer_capacity EOF; lines = Array.make buffer_capacity 1; @@ -151,7 +175,6 @@ let run scanner = let pe = scanner.pe in let eof = scanner.eof in let mark = scanner.mark in - let mark_end = scanner.mark_end in let tag = scanner.tag in pe := !eof; let pause () = @@ -159,16 +182,12 @@ let run scanner = !p < !eof then pe := !p + 1 in - let substr = String.sub in let sub () = assert (!mark >= 0); - if !mark_end < 0 then mark_end := !p; let text = - if !mark_end <= !mark then "" - else substr data !mark (!mark_end - !mark) + if !p <= !mark then "" else String.sub data !mark (!p - !mark) in mark := -1; - mark_end := -1; text in if scanner.tag_scan >= 0 then begin @@ -181,27 +200,55 @@ let run scanner = else begin let attrs = attributes result.Tag_attributes.attributes in let self_closing = result.Tag_attributes.self_closing in - match name with - | "script" | "style" | "title" | "textarea" -> - let after_tag = result.Tag_attributes.next in - let body = Raw_text.scan data after_tag name in - emit scanner (Start (make_tag ~self_closing name attrs)); - emit scanner (String body.Raw_text.text); - if body.Raw_text.had_end_tag then - emit scanner (End (make_tag name [])); - body.Raw_text.next - | _ -> - emit scanner (Start (make_tag ~self_closing name attrs)); - result.Tag_attributes.next + scanner.last_start_tag <- name; + emit scanner (Start (make_tag ~self_closing name attrs)); + result.Tag_attributes.next end in - for index = start to next - 1 do + for index = start + 1 to next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 done; p := next; cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true end + else if scanner.end_scan >= 0 then begin + let start = scanner.end_scan in + scanner.end_scan <- (-1); + let name = !tag in + let result = Tag_attributes.scan data start in + if result.Tag_attributes.ok then + emit scanner (End (make_tag name [])); + let next = + if result.Tag_attributes.ok then result.Tag_attributes.next else !eof + in + for index = start + 1 to next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.bogus >= 0 then begin + let start = scanner.bogus in + scanner.bogus <- (-1); + (* The consumed character is a codepoint, not a byte. *) + let width = + if data.[start] < '\x80' then 1 + else if data.[start] < '\xE0' then 2 + else if data.[start] < '\xF0' then 3 + else 4 + in + let start = min (start + width) !eof in + let result = Markup_declaration.bogus_comment data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end else if scanner.declaration >= 0 then begin let start = scanner.declaration in scanner.declaration <- (-1); @@ -216,12 +263,57 @@ let run scanner = end else begin %%write exec; - if scanner.declaration >= 0 || scanner.tag_scan >= 0 then () + if + scanner.declaration >= 0 || scanner.bogus >= 0 || scanner.tag_scan >= 0 + || scanner.end_scan >= 0 + then () else if !p >= !eof then scanner.finished <- true else if scanner.write = 0 then scanner.finished <- true end -let rec next scanner (_state : Html_tokenizer.state) +(* The tree builder requested a non-Data state for the next scan; the last + start tag emitted is the appropriate end tag. In fragment parsing no start + tag has been seen, so no end tag ever matches. *) +let scan_raw_state scanner state = + let data = scanner.data in + let start = !(scanner.p) in + if start >= !(scanner.eof) then scanner.finished <- true + else begin + let next_index = + match (state : Html_tokenizer.state) with + | PLAINTEXT -> + let body = Raw_text.plaintext data start in + emit scanner (String body.Raw_text.text); + body.Raw_text.next + | _ -> + let name = scanner.last_start_tag in + if name = "" then begin + let body = Raw_text.plaintext data start in + let text = + match (state : Html_tokenizer.state) with + | RCDATA -> decode body.Raw_text.text + | _ -> body.Raw_text.text + in + emit scanner (String text); + body.Raw_text.next + end + else begin + let body = Raw_text.scan data start name in + emit scanner (String body.Raw_text.text); + if body.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + body.Raw_text.next + end + in + for index = start to next_index - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + scanner.p := next_index; + scanner.cs := htmlstream_en_main; + if next_index >= !(scanner.eof) then scanner.finished <- true + end + +let rec next scanner (state : Html_tokenizer.state) (location : location_out) = if scanner.read < scanner.write then begin let index = scanner.read in @@ -237,9 +329,15 @@ let rec next scanner (_state : Html_tokenizer.state) location.column <- -1; EOF end + else if state <> Data then begin + scanner.read <- 0; + scanner.write <- 0; + scan_raw_state scanner state; + next scanner Data location + end else begin scanner.read <- 0; scanner.write <- 0; run scanner; - next scanner _state location + next scanner state location end diff --git a/src/lite/raw_text.ml b/src/lite/raw_text.ml index 9a2c08e..1c45275 100644 --- a/src/lite/raw_text.ml +++ b/src/lite/raw_text.ml @@ -19,6 +19,14 @@ let add buffer byte = let is_whitespace = function '\t' | '\n' | '\x0C' | ' ' -> true | _ -> false let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false +let plaintext data start = + let length = String.length data in + let buffer = Buffer.create (length - start) in + for index = start to length - 1 do + add buffer data.[index] + done; + { text = Buffer.contents buffer; had_end_tag = false; next = length } + let scan data start tag = let length = String.length data in let decode = match tag with "title" | "textarea" -> true | _ -> false in diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 9385c28..b0ed8e5 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -92,6 +92,28 @@ let () = agrees "with attribute and end tag" "t"; ]; + "tag open text" + >::: [ + agrees "empty tag" "<>x"; + agrees "comparison operators" "text < 5 and > 3"; + agrees "space before name" "< div>x

"; + ]; + "attribute names" + >::: [ + agrees "quote as name" "
x"; + agrees "equals as name" "

x"; + agrees "control character in name" "

x"; + ]; + "rawtext elements" + >::: [ + agrees "noembed" "<span>xy"; + agrees "xmp" "

a<b>cd"; + ]; + "plaintext" + >::: [ + agrees "swallows rest" "

a<b>"; + agrees "end tag is text" "<plaintext>x</plaintext>y"; + ]; "fragment foreign" >::: [ agrees ~context:(`Fragment "svg") "td in svg" "<td>x"; From 2d6586aa227e1c0ec1b067ebf8bd98d0eab710bb Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 18:43:59 +0000 Subject: [PATCH 060/109] test: wire up lite_dump_signals with fragment support --- test/lite/lite_dump_signals.ml | 56 ++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) create mode 100644 test/lite/lite_dump_signals.ml diff --git a/test/lite/lite_dump_signals.ml b/test/lite/lite_dump_signals.ml new file mode 100644 index 0000000..4a648d0 --- /dev/null +++ b/test/lite/lite_dump_signals.ml @@ -0,0 +1,56 @@ +let collect iter stream = + let values = ref [] in + iter (fun value -> values := value :: !values) stream; + List.rev !values + +type outcome = Signals of Markup_common.signal list | Raised of string + +let run parse collect_signals input = + try Signals (collect_signals (parse input)) + with exn -> Raised (Printexc.to_string exn) + +let context_of_input input : [ `Document | `Fragment of string ] * string = + let prefix = "FRAGMENT " in + let plen = String.length prefix in + if String.length input >= plen && String.sub input 0 plen = prefix then + match String.index_from_opt input plen '\n' with + | Some nl -> + ( `Fragment (String.sub input plen (nl - plen)), + String.sub input (nl + 1) (String.length input - nl - 1) ) + | None -> (`Document, input) + else (`Document, input) + +let oracle context input = + run + (fun input -> Oracle.parse ~context (fun _ _ -> ()) input) + (collect Markup.iter) input + +let lite context input = + run + (fun input -> Markup_lite.parse_html ~context input) + (collect Markup_lite.iter) input + +let print label = function + | Raised exn -> Printf.printf "%s: RAISED %S\n" label exn + | Signals signals -> + Printf.printf "%s: %d signals\n" label (List.length signals); + List.iteri + (fun i signal -> + Printf.printf " %d: %S\n" i (Markup_common.signal_to_string signal)) + signals + +let read_all channel = + let buffer = Buffer.create 4096 in + (try + while true do + Buffer.add_channel buffer channel 1 + done + with End_of_file -> ()); + Buffer.contents buffer + +let () = + let input = read_all stdin in + let context, input = context_of_input input in + Printf.printf "input: %S\n" input; + print "oracle" (oracle context input); + print "lite" (lite context input) From 382cf9d158fcf5eacb59c2556efec2bff65224b2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 18:44:15 +0000 Subject: [PATCH 061/109] test: run lite baseline regressions in dune runtest --- test/lite/dune | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/lite/dune b/test/lite/dune index 7a29e11..4d69826 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -44,6 +44,11 @@ (action (run %{exe:lite_fuzz_regression.exe}))) +(rule + (alias runtest) + (action + (run %{exe:lite_baseline_regression.exe}))) + (executable (name lite_dump_signals) (modules lite_dump_signals) From 8385918dfb1ef2e8820b27373228ba667ee1718f Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:06:23 -0400 Subject: [PATCH 062/109] Raise the minimum OCaml version to 4.14 --- .github/workflows/test.yml | 15 +++------------ markup-lwt.opam | 2 +- markup.opam | 2 +- 3 files changed, 5 insertions(+), 14 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 81cd5af..d653677 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -8,17 +8,8 @@ jobs: fail-fast: false matrix: ocaml: - - 4.13.1 - - 4.12.1 - - 4.11.2 - - 4.10.2 - - 4.09.1 - - 4.08.1 - - 4.07.1 - - 4.06.1 - - 4.05.0 - - 4.04.2 - - 4.03.0 + - 5.4.1 + - 4.14.2 steps: - uses: actions/checkout@v2 @@ -34,7 +25,7 @@ jobs: - run: opam exec -- make dependency-test - run: opam lint - - if: ${{matrix.ocaml == '4.13.1'}} + - if: ${{matrix.ocaml == '5.4.1'}} env: COVERALLS_REPO_TOKEN: ${{secrets.GITHUB_TOKEN}} PULL_REQUEST_NUMBER: ${{github.event.number}} diff --git a/markup-lwt.opam b/markup-lwt.opam index 21e5ac2..94bdf7e 100644 --- a/markup-lwt.opam +++ b/markup-lwt.opam @@ -16,7 +16,7 @@ depends: [ "dune" {>= "2.7.0"} "lwt" "markup" - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.14.0"} ] build: [ diff --git a/markup.opam b/markup.opam index 073f164..7a153b6 100644 --- a/markup.opam +++ b/markup.opam @@ -13,7 +13,7 @@ dev-repo: "git+https://github.com/aantron/markup.ml.git" depends: [ "dune" {>= "2.7.0"} - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.14.0"} "uchar" "uutf" {>= "1.0.0"} From 2928e1775de9f3a05a35af7d6d2ce5f6b9d15d90 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:06:30 -0400 Subject: [PATCH 063/109] Use String.is_valid_utf_8 for Lite input validation --- src/lite/token_source.ml | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 0ed37ad..2b2d9a7 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -13,13 +13,7 @@ type t = { mutable pushed : pushed_token list; } -let valid_utf_8 html = - try - Uutf.String.fold_utf_8 - (fun () _ -> function `Uchar _ -> () | `Malformed _ -> raise Exit) - () html; - true - with Exit -> false +let valid_utf_8 = String.is_valid_utf_8 let replace_malformed html = let buffer = Buffer.create (String.length html + 16) in From c6b2c1a45e167bba331ee6c79750cfe20249d95f Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:06:33 -0400 Subject: [PATCH 064/109] Preserve internal BOM characters during HTML preprocessing --- src/baseline/input.ml | 7 +++++-- src/lite/token_source.ml | 31 ++++++++++--------------------- 2 files changed, 15 insertions(+), 23 deletions(-) diff --git a/src/baseline/input.ml b/src/baseline/input.ml index 136036e..7e9f17f 100644 --- a/src/baseline/input.ml +++ b/src/baseline/input.ml @@ -27,8 +27,11 @@ let preprocess is_valid_char report source = in let rec iterate () = - next source throw empty (function - | 0xFEFF when !first_char -> first_char := false; iterate () + next source throw empty (fun c -> + let was_first = !first_char in + first_char := false; + match c with + | 0xFEFF when was_first -> iterate () | 0x0D -> next source throw newline (function diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 2b2d9a7..249d057 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -45,29 +45,18 @@ let normalize_newlines html = Buffer.contents buffer end -(* Like src/baseline: the uutf decoder drops a leading BOM, then the input - preprocessor drops the first U+FEFF found anywhere in the stream. *) -let remove_first_bom html = +(* The baseline UTF-8 decoder consumes one leading BOM, and its input + preprocessor consumes one more leading U+FEFF. *) +let strip_leading_bom html = let length = String.length html in - let rec find index = - if index + 3 > length then None - else if - html.[index] = '\xEF' - && html.[index + 1] = '\xBB' - && html.[index + 2] = '\xBF' - then Some index - else find (index + 1) + let has_bom index = + index + 3 <= length + && html.[index] = '\xEF' + && html.[index + 1] = '\xBB' + && html.[index + 2] = '\xBF' in - match find 0 with - | None -> html - | Some index -> - String.sub html 0 index ^ String.sub html (index + 3) (length - index - 3) - -let strip_leading_bom html = - let bom = "\xEF\xBB\xBF" in - if String.length html >= 3 && String.sub html 0 3 = bom then - remove_first_bom (String.sub html 3 (String.length html - 3)) - else remove_first_bom html + let start = if not (has_bom 0) then 0 else if has_bom 3 then 6 else 3 in + if start = 0 then html else String.sub html start (length - start) let create html = let html = if valid_utf_8 html then html else replace_malformed html in From 0085f0bfd52da40b7c1f6d6cd298ca0834758719 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:06:38 -0400 Subject: [PATCH 065/109] Add BOM preprocessing regression tests --- test/lite/lite_baseline_regression.ml | 99 ++++++++++++++++++++++++++- 1 file changed, 98 insertions(+), 1 deletion(-) diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index b0ed8e5..63ef505 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -13,6 +13,12 @@ let lite context html = collect Markup_lite.iter (Markup_lite.parse_html ~report:(fun _ _ -> ()) ~context html) +let lite_tokens ?(report = fun _ _ -> ()) context tokens = + collect Markup_lite.iter (Markup_lite.parse_tokens ~report ~context tokens) + +let token_tag name = + Markup_lite.Token_tag.{ name; attributes = []; self_closing = false } + let print_signals signals = signals |> List.map Markup_common.signal_to_string @@ -23,6 +29,29 @@ let agrees ?(context = `Document) name html = assert_equal ~printer:print_signals (baseline context html) (lite context html) +let agrees_with_text ?(context = `Document) name html text = + name >:: fun _ -> + let expected = baseline context html in + let actual = lite context html in + assert_equal ~printer:print_signals expected actual; + assert_bool "expected text signal was not preserved" + (List.exists + (function + | `Text strings -> String.concat "" strings = text | _ -> false) + actual) + +let disagrees ?(context = `Document) name html = + name >:: fun _ -> + assert_bool "baseline and lite now agree; promote this test to [agrees]" + (baseline context html <> lite context html) + +(* FIXME *) +(* this input makes the parser loop forever (misnested math/tr in row mode) *) +let terminates = + "in row misnested math" >:: fun _ -> + if false then + ignore (lite `Document "<table><tr><math></tr><td><tr><b><math>0") + let () = run_test_tt_main ("Lite vs baseline regressions" @@ -73,7 +102,9 @@ let () = "bom" >::: [ agrees "leading bom" "\xEF\xBB\xBFa"; - agrees "bom in text" "a\xEF\xBB\xBFb"; + agrees_with_text "internal bom is preserved" "a\xEF\xBB\xBFb" + "a\xEF\xBB\xBFb"; + agrees "two leading boms" "\xEF\xBB\xBF\xEF\xBB\xBFa"; ]; "table whitespace" >::: [ @@ -120,4 +151,70 @@ let () = agrees ~context:(`Fragment "svg") "div span in svg" "<div><span></div>"; ]; + "parse_tokens" + >::: [ + ( "document" >:: fun _ -> + let tokens = + [ + ((1, 1), `Start (token_tag "p")); + ((1, 4), `String "x"); + ((1, 5), `End (token_tag "p")); + ((1, 9), `EOF); + ] + in + assert_equal ~printer:print_signals + (lite `Document "<p>x</p>") + (lite_tokens `Document tokens) ); + ( "fragment" >:: fun _ -> + let tokens = [ ((1, 1), `String "<b>"); ((1, 4), `EOF) ] in + assert_equal ~printer:print_signals + (lite (`Fragment "textarea") "&lt;b>") + (lite_tokens (`Fragment "textarea") tokens) ); + ( "report location" >:: fun _ -> + let reports = ref [] in + let tokens = + [ ((7, 11), `End (token_tag "p")); ((7, 15), `EOF) ] + in + ignore + (lite_tokens + ~report:(fun location error -> + reports := (location, error) :: !reports) + `Document tokens); + assert_bool "token location was not reported" + (List.exists + (fun (location, _) -> location = (7, 11)) + !reports) ); + ]; + "known divergence: foreign breakout reentry" + >::: [ + disagrees "svg b svg text" "<svg><b><svg>ab"; + disagrees "math b math text" "<math><b><math>xy"; + disagrees "svg s svg digits" "<svg><s><svg>00"; + ]; + "known divergence: cdata in foreign content" + >::: [ + disagrees "svg" "<svg><![CDATA[a]]></svg>"; + disagrees "math" "<math><![CDATA[1]]></math>"; + ]; + "known divergence: form feed whitespace" + >::: [ + disagrees "alone" "\x0C"; + disagrees "after col" "<table><col>\x0C"; + disagrees "after template" "<template></template>\x0C"; + ]; + "known divergence: nul reconstructs formatting" + >::: [ + disagrees "p b p" "<p><b><p>\x00"; + disagrees "li s li" "<li><s><li>\x00<p"; + ]; + "known divergence: fragment breakout rawtext eof" + >::: [ + disagrees ~context:(`Fragment "svg") "style slash" + "<p></p><style></"; + disagrees ~context:(`Fragment "svg") "script candidate" + "<p></p><script></x"; + disagrees ~context:(`Fragment "math") "style candidate" + "<p></p><style></x"; + ]; + "known non-termination" >::: [ terminates ]; ]) From 809abdda6b82e6f97ecd9759f0b4aac1a37619ce Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:20:13 -0400 Subject: [PATCH 066/109] Treat form feed as whitespace in Lite text tokens --- src/lite/common.ml | 3 ++- test/lite/lite_baseline_regression.ml | 8 ++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/lite/common.ml b/src/lite/common.ml index 0b08a8e..c8ec639 100644 --- a/src/lite/common.ml +++ b/src/lite/common.ml @@ -104,7 +104,8 @@ let is_whitespace_only s = try s |> String.iter (fun c -> - if is_whitespace (int_of_char c) then () else raise Exit); + let c = int_of_char c in + if c = 0x000C || is_whitespace c then () else raise Exit); true with Exit -> false diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 63ef505..8fba6df 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -196,11 +196,11 @@ let () = disagrees "svg" "<svg><![CDATA[a]]></svg>"; disagrees "math" "<math><![CDATA[1]]></math>"; ]; - "known divergence: form feed whitespace" + "form feed whitespace" >::: [ - disagrees "alone" "\x0C"; - disagrees "after col" "<table><col>\x0C"; - disagrees "after template" "<template></template>\x0C"; + agrees "alone" "\x0C"; + agrees "after col" "<table><col>\x0C"; + agrees "after template" "<template></template>\x0C"; ]; "known divergence: nul reconstructs formatting" >::: [ From 4c41008be6fbc8e8bc9da45b5968538cdfe6f640 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:22:47 -0400 Subject: [PATCH 067/109] Skip formatting reconstruction for discarded NUL text --- src/lite/html_parser.ml | 10 ++++++---- test/lite/lite_baseline_regression.ml | 6 +++--- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index e8d7128..85a2242 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -1575,10 +1575,12 @@ let parse ?depth_limit requested_context report tokens = | l, Char 0 -> report l (`Bad_token ("U+0000", "body", "null")) !throw mode | l, String s -> let s = remove_nulls s in - reconstruct_active_formatting_elements (fun () -> - add_string l s; - if not @@ is_whitespace_only s then frameset_ok := false; - mode ()) + if s = "" then mode () + else + reconstruct_active_formatting_elements (fun () -> + add_string l s; + if not @@ is_whitespace_only s then frameset_ok := false; + mode ()) | l, Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> reconstruct_active_formatting_elements (fun () -> add_character l c; diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 8fba6df..a3e19c2 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -202,10 +202,10 @@ let () = agrees "after col" "<table><col>\x0C"; agrees "after template" "<template></template>\x0C"; ]; - "known divergence: nul reconstructs formatting" + "nul does not reconstruct formatting" >::: [ - disagrees "p b p" "<p><b><p>\x00"; - disagrees "li s li" "<li><s><li>\x00<p"; + agrees "p b p" "<p><b><p>\x00"; + agrees "li s li" "<li><s><li>\x00<p"; ]; "known divergence: fragment breakout rawtext eof" >::: [ From 96e744c25a9cd7b1adc2a62650fdbaf3b32ab163 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:28:51 -0400 Subject: [PATCH 068/109] Parse CDATA sections in foreign content --- src/lite/html_parser.ml | 3 +++ src/lite/markup_declaration.ml | 33 ++++++++++++++++++++++++++- src/lite/ragel_html_tokenizer.ml | 13 ++++++----- src/lite/ragel_html_tokenizer.ml.rl | 12 +++++----- src/lite/ragel_html_tokenizer.mli | 4 +++- src/lite/token_source.ml | 11 +++++++-- src/lite/token_source.mli | 1 + test/lite/lite_baseline_regression.ml | 6 ++--- 8 files changed, 64 insertions(+), 19 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index 85a2242..886e2bd 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -1038,6 +1038,9 @@ let parse ?depth_limit requested_context report tokens = let add_character = Text.add text in let add_string = Text.add_string text in + Token_source.set_foreign tokens (fun () -> + Stack.current_element_is_foreign context open_elements); + let report_if_stack_has_other_than names k = let rec iterate = function | [] -> k () diff --git a/src/lite/markup_declaration.ml b/src/lite/markup_declaration.ml index d559e7f..1c95b4d 100644 --- a/src/lite/markup_declaration.ml +++ b/src/lite/markup_declaration.ml @@ -18,6 +18,16 @@ let add buffer byte = let is_whitespace = function '\t' | '\n' | '\x0C' | ' ' -> true | _ -> false +let matches data index keyword = + index + String.length keyword <= String.length data + && begin + let rec check offset = + offset >= String.length keyword + || (data.[index + offset] = keyword.[offset] && check (offset + 1)) + in + check 0 + end + let matches_lowercase data index keyword = index + String.length keyword <= String.length data && begin @@ -307,7 +317,26 @@ let doctype data start = in doctype_start start -let scan data index = +let cdata data start = + let length = String.length data in + let buffer = Buffer.create 64 in + let finish next = { token = `String (Buffer.contents buffer); next } in + let rec consume index = + if index >= length then finish index + else if + index + 3 <= length + && data.[index] = ']' + && data.[index + 1] = ']' + && data.[index + 2] = '>' + then finish (index + 3) + else begin + add buffer data.[index]; + consume (index + 1) + end + in + consume start + +let scan ~foreign data index = if data.[index] = '?' then bogus_comment data (index + 1) else if index + 3 <= String.length data @@ -316,4 +345,6 @@ let scan data index = then comment data (index + 3) else if matches_lowercase data (index + 1) "doctype" then doctype data (index + 8) + else if foreign && matches data (index + 1) "[CDATA[" then + cdata data (index + 8) else bogus_comment data (index + 1) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index dde2a4c..fcc6b55 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -599,7 +599,7 @@ let create data = finished = false; } -let run scanner = +let run scanner foreign = let data = scanner.data in let cs = scanner.cs in let p = scanner.p in @@ -679,7 +679,7 @@ let run scanner = else if scanner.declaration >= 0 then begin let start = scanner.declaration in scanner.declaration <- -1; - let result = Markup_declaration.scan data start in + let result = Markup_declaration.scan ~foreign data start in emit scanner result.Markup_declaration.token; for index = start to result.Markup_declaration.next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 @@ -948,7 +948,8 @@ let scan_raw_state scanner state = if next_index >= !(scanner.eof) then scanner.finished <- true end -let rec next scanner (state : Html_tokenizer.state) (location : location_out) = +let rec next scanner (state : Html_tokenizer.state) foreign + (location : location_out) = if scanner.read < scanner.write then begin let index = scanner.read in let token = scanner.tokens.(index) in @@ -967,11 +968,11 @@ let rec next scanner (state : Html_tokenizer.state) (location : location_out) = scanner.read <- 0; scanner.write <- 0; scan_raw_state scanner state; - next scanner Data location + next scanner Data foreign location end else begin scanner.read <- 0; scanner.write <- 0; - run scanner; - next scanner state location + run scanner foreign; + next scanner state foreign location end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 41f6c6c..e5c7606 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -168,7 +168,7 @@ let create data = write = 0; finished = false} -let run scanner = +let run scanner foreign = let data = scanner.data in let cs = scanner.cs in let p = scanner.p in @@ -252,7 +252,7 @@ let run scanner = else if scanner.declaration >= 0 then begin let start = scanner.declaration in scanner.declaration <- (-1); - let result = Markup_declaration.scan data start in + let result = Markup_declaration.scan ~foreign data start in emit scanner result.Markup_declaration.token; for index = start to result.Markup_declaration.next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 @@ -313,7 +313,7 @@ let scan_raw_state scanner state = if next_index >= !(scanner.eof) then scanner.finished <- true end -let rec next scanner (state : Html_tokenizer.state) +let rec next scanner (state : Html_tokenizer.state) foreign (location : location_out) = if scanner.read < scanner.write then begin let index = scanner.read in @@ -333,11 +333,11 @@ let rec next scanner (state : Html_tokenizer.state) scanner.read <- 0; scanner.write <- 0; scan_raw_state scanner state; - next scanner Data location + next scanner Data foreign location end else begin scanner.read <- 0; scanner.write <- 0; - run scanner; - next scanner state location + run scanner foreign; + next scanner state foreign location end diff --git a/src/lite/ragel_html_tokenizer.mli b/src/lite/ragel_html_tokenizer.mli index 18b19b3..96cf1f4 100644 --- a/src/lite/ragel_html_tokenizer.mli +++ b/src/lite/ragel_html_tokenizer.mli @@ -5,4 +5,6 @@ type location_out = { mutable line : int; mutable column : int } type t val create : string -> t -val next : t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token + +val next : + t -> Html_tokenizer.state -> bool -> location_out -> Html_tokenizer.token diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 249d057..ebd081b 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -11,6 +11,7 @@ type pushed_token = { token : Html_tokenizer.token; line : int; column : int } type t = { scanner : Ragel_html_tokenizer.t; mutable pushed : pushed_token list; + mutable foreign : unit -> bool; } let valid_utf_8 = String.is_valid_utf_8 @@ -62,7 +63,11 @@ let create html = let html = if valid_utf_8 html then html else replace_malformed html in let html = strip_leading_bom html in let html = normalize_newlines html in - { scanner = Ragel_html_tokenizer.create html; pushed = [] } + { + scanner = Ragel_html_tokenizer.create html; + pushed = []; + foreign = (fun () -> false); + } let location () = { line = 1; column = -1 } @@ -73,7 +78,9 @@ let next source state (out : location_out) = out.line <- line; out.column <- column; token - | [] -> Ragel_html_tokenizer.next source.scanner state out + | [] -> Ragel_html_tokenizer.next source.scanner state (source.foreign ()) out + +let set_foreign source foreign = source.foreign <- foreign let push source ((line, column), token) = source.pushed <- { token; line; column } :: source.pushed diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli index 315c658..563425e 100644 --- a/src/lite/token_source.mli +++ b/src/lite/token_source.mli @@ -9,4 +9,5 @@ type t val create : string -> t val location : unit -> location_out val next : t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token +val set_foreign : t -> (unit -> bool) -> unit val push : t -> location * Html_tokenizer.token -> unit diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index a3e19c2..8f846e3 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -191,10 +191,10 @@ let () = disagrees "math b math text" "<math><b><math>xy"; disagrees "svg s svg digits" "<svg><s><svg>00"; ]; - "known divergence: cdata in foreign content" + "cdata in foreign content" >::: [ - disagrees "svg" "<svg><![CDATA[a]]></svg>"; - disagrees "math" "<math><![CDATA[1]]></math>"; + agrees "svg" "<svg><![CDATA[a]]></svg>"; + agrees "math" "<math><![CDATA[1]]></math>"; ]; "form feed whitespace" >::: [ From 6bf36a9ae2f6262744dbb468b636ff6726bfafb3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 17:38:55 -0400 Subject: [PATCH 069/109] Match foreign fragment rawtext candidate recovery --- src/lite/ragel_html_tokenizer.ml | 1576 ++++++++++--------------- src/lite/ragel_html_tokenizer.ml.rl | 8 +- src/lite/raw_text.ml | 8 +- test/lite/lite_baseline_regression.ml | 11 +- 4 files changed, 649 insertions(+), 954 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index fcc6b55..e3e967d 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -1,978 +1,666 @@ (* Derived from Devkit htmlStream_ragel.ml.rl. - Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. - The original source is available from https://github.com/ygrek/ocaml-webstack. *) +Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. +The original source is available from https://github.com/ygrek/ocaml-webstack. *) [@@@ocaml.warning "-38-32"] open Common open Html_tokenizer -type location_out = { mutable line : int; mutable column : int } +type location_out = { + mutable line : int; + mutable column : int; +} type t = { - data : string; - cs : int ref; - p : int ref; - pe : int ref; - eof : int ref; - mark : int ref; - tag : string ref; - mutable last_start_tag : string; - mutable declaration : int; - mutable bogus : int; - mutable tag_scan : int; - mutable end_scan : int; - mutable line : int; - tokens : Html_tokenizer.token array; - lines : int array; - mutable read : int; - mutable write : int; - mutable finished : bool; + data : string; + cs : int ref; + p : int ref; + pe : int ref; + eof : int ref; + mark : int ref; + tag : string ref; + mutable last_start_tag : string; + mutable declaration : int; + mutable bogus : int; + mutable tag_scan : int; + mutable end_scan : int; + mutable line : int; + tokens : Html_tokenizer.token array; + lines : int array; + mutable read : int; + mutable write : int; + mutable finished : bool; } let decode = Html_entity_decoder.decode (* The first occurrence of a name wins, like src/baseline. *) let attributes attrs = - let rec dedupe seen = function - | [] -> [] - | (name, value) :: rest -> - if List.mem name seen then dedupe seen rest - else - (name, Html_entity_decoder.decode_attribute value) - :: dedupe (name :: seen) rest - in - dedupe [] attrs +let rec dedupe seen = function +| [] -> [] +| (name, value) :: rest -> +if List.mem name seen then dedupe seen rest +else +(name, Html_entity_decoder.decode_attribute value) +:: dedupe (name :: seen) rest +in +dedupe [] attrs let make_tag ?(self_closing = false) name attributes = - { Token_tag.name; attributes; self_closing } +{Token_tag.name; attributes; self_closing} let normalize_name text = - let text = String.lowercase_ascii text in - if not (String.contains text '\x00') then text - else begin - let buffer = Buffer.create (String.length text + 8) in - String.iter - (fun byte -> - if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" - else Buffer.add_char buffer byte) - text; - Buffer.contents buffer - end +let text = String.lowercase_ascii text in +if not (String.contains text '\x00') then text +else begin + let buffer = Buffer.create (String.length text + 8) in + String.iter + (fun byte -> + if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" + else Buffer.add_char buffer byte) + text; + Buffer.contents buffer +end let buffer_capacity = 128 let maximum_transition_output = 3 let emit scanner token = - scanner.tokens.(scanner.write) <- token; - scanner.lines.(scanner.write) <- scanner.line; - scanner.write <- scanner.write + 1 +scanner.tokens.(scanner.write) <- token; +scanner.lines.(scanner.write) <- scanner.line; +scanner.write <- scanner.write + 1 (* The tree builder treats a leading whitespace run differently from the rest - of a text run in several insertion modes; src/baseline gets this for free - from per-character tokens. *) +of a text run in several insertion modes; src/baseline gets this for free +from per-character tokens. *) let emit_text scanner text = - let length = String.length text in - let rec whitespace_end index = - if index < length then - match text.[index] with - | '\t' | '\n' | '\x0C' | '\r' | ' ' -> whitespace_end (index + 1) - | _ -> index - else index - in - let boundary = whitespace_end 0 in - if boundary = 0 || boundary = length then emit scanner (String text) - else begin - emit scanner (String (String.sub text 0 boundary)); - emit scanner (String (String.sub text boundary (length - boundary))) - end - -let _htmlstream_trans_keys : int array = - Array.concat [ [| 10; 60; 10; 60; 10; 122; 10; 122; 9; 62; 9; 62; 0 |] ] - -let _htmlstream_key_spans : int array = - Array.concat [ [| 51; 51; 113; 113; 54; 54 |] ] - -let _htmlstream_index_offsets : int array = - Array.concat [ [| 0; 52; 104; 218; 332; 387 |] ] - -let _htmlstream_indicies : int array = - Array.concat - [ - [| - 1; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 0; - 2; - 0; - 4; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 3; - 5; - 3; - 7; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 8; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 9; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 6; - 8; - 6; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 6; - 6; - 6; - 6; - 6; - 6; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 10; - 6; - 12; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 11; - 13; - 11; - 11; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 11; - 11; - 11; - 11; - 11; - 11; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 14; - 11; - 16; - 17; - 15; - 16; - 16; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 16; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 16; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 15; - 16; - 15; - 19; - 20; - 18; - 19; - 19; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 19; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 19; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 18; - 19; - 18; - 0; - |]; - ] - -let _htmlstream_trans_targs : int array = - Array.concat - [ [| 1; 1; 2; 1; 1; 2; 0; 0; 0; 3; 5; 0; 0; 0; 4; 4; 1; 1; 5; 1; 1 |] ] - -let _htmlstream_trans_actions : int array = - Array.concat - [ - [| 1; 2; 0; 0; 4; 3; 6; 7; 8; 0; 1; 10; 11; 0; 1; 0; 13; 14; 0; 16; 17 |]; - ] - -let _htmlstream_eof_actions : int array = - Array.concat [ [| 0; 3; 5; 9; 12; 15 |] ] - -let htmlstream_start : int = 0 -let htmlstream_first_final : int = 0 -let htmlstream_error : int = -1 -let htmlstream_en_main : int = 0 - -type _htmlstream_state = { mutable keys : int; mutable trans : int } - -exception Goto_match_htmlstream -exception Goto_again_htmlstream -exception Goto_eof_trans_htmlstream - +let length = String.length text in +let rec whitespace_end index = +if index < length then +match text.[index] with +| '\t' | '\n' | '\x0C' | '\r' | ' ' -> whitespace_end (index + 1) +| _ -> index +else index +in +let boundary = whitespace_end 0 in +if boundary = 0 || boundary = length then emit scanner (String text) +else begin + emit scanner (String (String.sub text 0 boundary)); + emit scanner (String (String.sub text boundary (length - boundary))) +end + +let _htmlstream_trans_keys : int array = [| +1; 5; 1; 5; 1; 7; 1; 7; 0; 6; 0; 6; 0 ; +|] +let _htmlstream_char_class : int array = [| +0; 1; 2; 0; 0; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 0; 3; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 4; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 5; 2; 6; 3; 2; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 2; 2; 2; 2; 2; 2; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 0 ; +|] +let _htmlstream_index_offsets : int array = [| +0; 5; 10; 17; 24; 31; 0 ; +|] +let _htmlstream_indices : int array = [| +2; 1; 1; 1; 3; 6; 5; 5; 5; 7; 10; 9; 11; 12; 9; 9; 13; 16; 15; 15; 15; 15; 0; 17; 20; 21; 19; 19; 20; 19; 20; 24; 25; 23; 23; 24; 23; 24; 0 ; +|] +let _htmlstream_index_defaults : int array = [| +1; 5; 9; 15; 19; 23; 0 ; +|] +let _htmlstream_cond_targs : int array = [| +0; 1; 1; 2; 1; 1; 1; 2; 2; 0; 0; 0; 3; 5; 3; 0; 0; 4; 4; 4; 1; 1; 5; 5; 1; 1; 0 ; +|] +let _htmlstream_cond_actions : int array = [| +0; 1; 2; 0; 3; 0; 4; 3; 5; 6; 7; 8; 0; 1; 9; 10; 11; 1; 12; 0; 13; 14; 15; 0; 16; 17; 0 ; +|] +let _htmlstream_eof_trans : int array = [| +1; 5; 9; 15; 19; 23; 0 ; +|] +let htmlstream_start : int = 0 +let htmlstream_first_final : int = 0 +let htmlstream_error : int = -1 +let htmlstream_en_main : int = 0 let create data = - let cs = ref 0 in - - begin - cs.contents <- htmlstream_start - end; - - let length = String.length data in - { - data; - cs; - p = ref 0; - pe = ref length; - eof = ref length; - mark = ref (-1); - tag = ref ""; - last_start_tag = ""; - declaration = -1; - bogus = -1; - tag_scan = -1; - end_scan = -1; - line = 1; - tokens = Array.make buffer_capacity EOF; - lines = Array.make buffer_capacity 1; - read = 0; - write = 0; - finished = false; - } +let cs = ref 0 in +begin + cs := htmlstream_start; + +end; +let length = String.length data in +{data; + cs; + p = ref 0; + pe = ref length; + eof = ref length; + mark = ref (-1); + tag = ref ""; + last_start_tag = ""; + declaration = (-1); + bogus = (-1); + tag_scan = (-1); + end_scan = (-1); + line = 1; + tokens = Array.make buffer_capacity EOF; + lines = Array.make buffer_capacity 1; + read = 0; + write = 0; + finished = false} let run scanner foreign = - let data = scanner.data in - let cs = scanner.cs in - let p = scanner.p in - let pe = scanner.pe in - let eof = scanner.eof in - let mark = scanner.mark in - let tag = scanner.tag in - pe := !eof; - let pause () = - if scanner.write >= buffer_capacity - maximum_transition_output && !p < !eof - then pe := !p + 1 - in - let sub () = - assert (!mark >= 0); - let text = if !p <= !mark then "" else String.sub data !mark (!p - !mark) in - mark := -1; - text - in - if scanner.tag_scan >= 0 then begin - let start = scanner.tag_scan in - scanner.tag_scan <- -1; - let name = !tag in - let result = Tag_attributes.scan data start in - let next = - if not result.Tag_attributes.ok then !eof - else begin - let attrs = attributes result.Tag_attributes.attributes in - let self_closing = result.Tag_attributes.self_closing in - scanner.last_start_tag <- name; - emit scanner (Start (make_tag ~self_closing name attrs)); - result.Tag_attributes.next - end - in - for index = start + 1 to next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true - end - else if scanner.end_scan >= 0 then begin - let start = scanner.end_scan in - scanner.end_scan <- -1; - let name = !tag in - let result = Tag_attributes.scan data start in - if result.Tag_attributes.ok then emit scanner (End (make_tag name [])); - let next = - if result.Tag_attributes.ok then result.Tag_attributes.next else !eof - in - for index = start + 1 to next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true - end - else if scanner.bogus >= 0 then begin - let start = scanner.bogus in - scanner.bogus <- -1; - (* The consumed character is a codepoint, not a byte. *) - let width = - if data.[start] < '\x80' then 1 - else if data.[start] < '\xE0' then 2 - else if data.[start] < '\xF0' then 3 - else 4 - in - let start = min (start + width) !eof in - let result = Markup_declaration.bogus_comment data start in - emit scanner result.Markup_declaration.token; - for index = start to result.Markup_declaration.next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := result.Markup_declaration.next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true - end - else if scanner.declaration >= 0 then begin - let start = scanner.declaration in - scanner.declaration <- -1; - let result = Markup_declaration.scan ~foreign data start in - emit scanner result.Markup_declaration.token; - for index = start to result.Markup_declaration.next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := result.Markup_declaration.next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true - end - else begin - begin - let state = { keys = 0; trans = 0 } in - let rec do_start () = - if p.contents = pe.contents then do_test_eof () else do_resume () - and do_resume () = - begin try - let keys = cs.contents lsl 1 in - let inds = _htmlstream_index_offsets.(cs.contents) in - - let slen = _htmlstream_key_spans.(cs.contents) in - state.trans <- - _htmlstream_indicies.(inds - + - if - slen > 0 - && _htmlstream_trans_keys.(keys) - <= Char.code data.[p.contents] - && Char.code data.[p.contents] - <= _htmlstream_trans_keys.(keys + 1) - then - Char.code data.[p.contents] - - _htmlstream_trans_keys.(keys) - else slen) - with Goto_match_htmlstream -> () - end; - do_eof_trans () - and do_eof_trans () = - cs.contents <- _htmlstream_trans_targs.(state.trans); - - begin try - if _htmlstream_trans_actions.(state.trans) = 0 then - raise_notrace Goto_again_htmlstream; - - match _htmlstream_trans_actions.(state.trans) with - | 1 -> - begin - mark := !p - end; - () - | 3 -> - begin - emit_text scanner (decode (sub ())); - pause () - end; - () - | 8 -> - begin - scanner.declaration <- !p; - pe := !p + 1 - end; - () - | 10 -> - begin - scanner.bogus <- !p; - pe := !p + 1 - end; - () - | 6 -> - begin - emit scanner (String "<"); - pause (); - p.contents <- p.contents - 1; - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - () - | 4 -> - begin - scanner.line <- scanner.line + 1 - end; - () - | 2 -> - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 13 -> - begin - tag := normalize_name @@ sub (); - scanner.end_scan <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - end; - begin - mark := !p - end; - () - | 16 -> - begin - tag := normalize_name @@ sub (); - scanner.tag_scan <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - end; - begin - mark := !p - end; - () - | 11 -> - begin - scanner.bogus <- !p; - pe := !p + 1 - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 7 -> - begin - emit scanner (String "<"); - pause (); - p.contents <- p.contents - 1; - begin - cs.contents <- 0; - if true then raise_notrace Goto_again_htmlstream - end - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 14 -> - begin - tag := normalize_name @@ sub (); - scanner.end_scan <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | 17 -> - begin - tag := normalize_name @@ sub (); - scanner.tag_scan <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - () - | _ -> () - with Goto_again_htmlstream -> () - end; - - do_again () - and do_again () = - p.contents <- p.contents + 1; - if p.contents <> pe.contents then do_resume () else do_test_eof () - and do_test_eof () = - if p.contents = eof.contents then - begin try - begin match _htmlstream_eof_actions.(cs.contents) with - | 12 -> - begin - tag := normalize_name @@ sub (); - scanner.end_scan <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - end; - () - | 3 -> - begin - emit_text scanner (decode (sub ())); - pause () - end; - () - | 15 -> - begin - tag := normalize_name @@ sub (); - scanner.tag_scan <- !p; - p.contents <- p.contents - 1; - pe := !p + 1 - end; - () - | 5 -> - begin - emit scanner (String "<") - end; - () - | 9 -> - begin - emit scanner (String "<"); - emit scanner (String "/") - end; - () - | _ -> () - end - with - | Goto_again_htmlstream -> do_again () - | Goto_eof_trans_htmlstream -> do_eof_trans () - end - in - do_start () - end; - - if - scanner.declaration >= 0 || scanner.bogus >= 0 || scanner.tag_scan >= 0 - || scanner.end_scan >= 0 - then () - else if !p >= !eof then scanner.finished <- true - else if scanner.write = 0 then scanner.finished <- true - end +let data = scanner.data in +let cs = scanner.cs in +let p = scanner.p in +let pe = scanner.pe in +let eof = scanner.eof in +let mark = scanner.mark in +let tag = scanner.tag in +pe := !eof; +let pause () = +if scanner.write >= buffer_capacity - maximum_transition_output && +!p < !eof then +pe := !p + 1 +in +let sub () = +assert (!mark >= 0); +let text = +if !p <= !mark then "" else String.sub data !mark (!p - !mark) +in +mark := -1; +text +in +if scanner.tag_scan >= 0 then begin + let start = scanner.tag_scan in + scanner.tag_scan <- (-1); + let name = !tag in + let result = Tag_attributes.scan data start in + let next = + if not result.Tag_attributes.ok then !eof + else begin + let attrs = attributes result.Tag_attributes.attributes in + let self_closing = result.Tag_attributes.self_closing in + scanner.last_start_tag <- name; + emit scanner (Start (make_tag ~self_closing name attrs)); + result.Tag_attributes.next + end + in + for index = start + 1 to next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true +end +else if scanner.end_scan >= 0 then begin + let start = scanner.end_scan in + scanner.end_scan <- (-1); + let name = !tag in + let result = Tag_attributes.scan data start in + if result.Tag_attributes.ok then + emit scanner (End (make_tag name [])); + let next = + if result.Tag_attributes.ok then result.Tag_attributes.next else !eof + in + for index = start + 1 to next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true +end +else if scanner.bogus >= 0 then begin + let start = scanner.bogus in + scanner.bogus <- (-1); + (* The consumed character is a codepoint, not a byte. *) + let width = + if data.[start] < '\x80' then 1 + else if data.[start] < '\xE0' then 2 + else if data.[start] < '\xF0' then 3 + else 4 + in + let start = min (start + width) !eof in + let result = Markup_declaration.bogus_comment data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true +end +else if scanner.declaration >= 0 then begin + let start = scanner.declaration in + scanner.declaration <- (-1); + let result = Markup_declaration.scan ~foreign data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true +end +else begin + begin + let _trans : int ref = ref ( 0 ) in + let _keys : int ref = ref 0 in + let _inds : int ref = ref 0 in + let _ic : int ref = ref 0 in + let _have : int ref = ref ( 0 ) in + let _cont : int ref = ref ( 1 ) in + let _again : int ref = ref ( 1 ) in + let _bsc : int ref = ref ( 1 ) in + while _again.contents= 1 && ( p.contents!= pe.contents|| p.contents= eof.contents ) do + begin + _cont := 1; + _again := 1; + if p.contents= eof.contents then + begin + begin + if _htmlstream_eof_trans.(cs.contents)> 0 then + begin + begin + _trans := _htmlstream_eof_trans.(cs.contents)- 1; + + end; + + end + ; + end; + + end + else + begin + begin + _keys := ( cs.contents lsl 1 ); + _inds := _htmlstream_index_offsets.(cs.contents); + if ( Char.code data.[p.contents] )<= 122 && ( Char.code data.[p.contents] )>= 9 then + begin + begin + _ic := _htmlstream_char_class.(( Char.code data.[p.contents] )- 9); + if _ic.contents<= _htmlstream_trans_keys.( _keys.contents+1 )&& _ic.contents>= _htmlstream_trans_keys.( _keys.contents ) then + begin + _trans := _htmlstream_indices.( _inds.contents+ ( _ic.contents- _htmlstream_trans_keys.( _keys.contents ) ) ); + + end + else + begin + _trans := _htmlstream_index_defaults.(cs.contents); + + end + ; + end; + + end + else + begin + begin + _trans := _htmlstream_index_defaults.(cs.contents); + + end; + + end + ; + end; + + end + ;cs := _htmlstream_cond_targs.(_trans.contents); + if _htmlstream_cond_actions.(_trans.contents)!= 0 then + begin + begin + if _htmlstream_cond_actions.(_trans.contents) = 1 then + begin + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 12 then + begin + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + begin + p := p.contents- 1; + + end; + + pe := !p + 1; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 3 then + begin + begin + emit_text scanner (decode (sub ())); + pause (); + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 15 then + begin + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + begin + p := p.contents- 1; + + end; + + pe := !p + 1; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 8 then + begin + begin + scanner.declaration <- !p; pe := !p + 1; + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 10 then + begin + begin + scanner.bogus <- !p; pe := !p + 1; + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 6 then + begin + begin + emit scanner (String "<"); + pause (); + begin + p := p.contents- 1; + + end; + + begin + cs := 0; + + end; + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 5 then + begin + begin + emit scanner (String "<") + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 9 then + begin + begin + emit scanner (String "<"); + emit scanner (String "/") + + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 4 then + begin + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 2 then + begin + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 13 then + begin + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + begin + p := p.contents- 1; + + end; + + pe := !p + 1; + + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 16 then + begin + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + begin + p := p.contents- 1; + + end; + + pe := !p + 1; + + end; + begin + mark := !p + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 11 then + begin + begin + scanner.bogus <- !p; pe := !p + 1; + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 7 then + begin + begin + emit scanner (String "<"); + pause (); + begin + p := p.contents- 1; + + end; + + begin + cs := 0; + + end; + + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 14 then + begin + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + begin + p := p.contents- 1; + + end; + + pe := !p + 1; + + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + else if _htmlstream_cond_actions.(_trans.contents) = 17 then + begin + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + begin + p := p.contents- 1; + + end; + + pe := !p + 1; + + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + + end + ; + + end; + + end + ;if _cont.contents= 1 then + begin + begin + if p.contents= eof.contents then + begin + begin + if cs.contents>= 0 then + begin + begin + _cont := 0; + _again := 0; + + end; + + end + ; + end; + + end + else + begin + begin + p := p.contents + 1; + begin + _cont := 0; + _again := 1; + + end; + + end; + + end + ;if _cont.contents= 1 then + begin + begin + begin + _cont := 0; + _again := 0; + + end; + + end; + + end + ; + end; + + end + ; + end; + + done; + + end; + if + scanner.declaration >= 0 || scanner.bogus >= 0 || scanner.tag_scan >= 0 + || scanner.end_scan >= 0 + then () + else if !p >= !eof then scanner.finished <- true + else if scanner.write = 0 then scanner.finished <- true +end (* The tree builder requested a non-Data state for the next scan; the last - start tag emitted is the appropriate end tag. In fragment parsing no start - tag has been seen, so no end tag ever matches. *) -let scan_raw_state scanner state = - let data = scanner.data in - let start = !(scanner.p) in - if start >= !(scanner.eof) then scanner.finished <- true - else begin - let next_index = - match (state : Html_tokenizer.state) with - | PLAINTEXT -> - let body = Raw_text.plaintext data start in - emit scanner (String body.Raw_text.text); - body.Raw_text.next - | _ -> - let name = scanner.last_start_tag in - if name = "" then begin - let body = Raw_text.plaintext data start in - let text = - match (state : Html_tokenizer.state) with - | RCDATA -> decode body.Raw_text.text - | _ -> body.Raw_text.text - in - emit scanner (String text); - body.Raw_text.next - end - else begin - let body = Raw_text.scan data start name in - emit scanner (String body.Raw_text.text); - if body.Raw_text.had_end_tag then - emit scanner (End (make_tag name [])); - body.Raw_text.next - end - in - for index = start to next_index - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - scanner.p := next_index; - scanner.cs := htmlstream_en_main; - if next_index >= !(scanner.eof) then scanner.finished <- true - end +start tag emitted is the appropriate end tag. In fragment parsing no start +tag has been seen, so no end tag ever matches. *) +let scan_raw_state scanner state foreign = +let data = scanner.data in +let start = !(scanner.p) in +if start >= !(scanner.eof) then scanner.finished <- true +else begin + let next_index = + match (state : Html_tokenizer.state) with + | PLAINTEXT -> + let body = Raw_text.plaintext data start in + emit scanner (String body.Raw_text.text); + body.Raw_text.next + | _ -> + let name = scanner.last_start_tag in + if name = "" then begin + let body = Raw_text.plaintext data start in + let text = + match (state : Html_tokenizer.state) with + | RCDATA -> decode body.Raw_text.text + | _ -> body.Raw_text.text + in + emit scanner (String text); + body.Raw_text.next + end + else begin + let body = + Raw_text.scan ~drop_end_tag_candidate:foreign data start name + in + emit scanner (String body.Raw_text.text); + if body.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + body.Raw_text.next + end + in + for index = start to next_index - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + scanner.p := next_index; + scanner.cs := htmlstream_en_main; + if next_index >= !(scanner.eof) then scanner.finished <- true +end let rec next scanner (state : Html_tokenizer.state) foreign - (location : location_out) = - if scanner.read < scanner.write then begin - let index = scanner.read in - let token = scanner.tokens.(index) in - location.line <- scanner.lines.(index); - location.column <- -1; - scanner.tokens.(index) <- EOF; - scanner.read <- index + 1; - token - end - else if scanner.finished then begin - location.line <- scanner.line; - location.column <- -1; - EOF - end - else if state <> Data then begin - scanner.read <- 0; - scanner.write <- 0; - scan_raw_state scanner state; - next scanner Data foreign location - end - else begin - scanner.read <- 0; - scanner.write <- 0; - run scanner foreign; - next scanner state foreign location - end +(location : location_out) = +if scanner.read < scanner.write then begin + let index = scanner.read in + let token = scanner.tokens.(index) in + location.line <- scanner.lines.(index); + location.column <- -1; + scanner.tokens.(index) <- EOF; + scanner.read <- index + 1; + token +end +else if scanner.finished then begin + location.line <- scanner.line; + location.column <- -1; + EOF +end +else if state <> Data then begin + scanner.read <- 0; + scanner.write <- 0; + scan_raw_state scanner state foreign; + next scanner Data foreign location +end +else begin + scanner.read <- 0; + scanner.write <- 0; + run scanner foreign; + next scanner state foreign location +end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index e5c7606..21ce17d 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -274,7 +274,7 @@ let run scanner foreign = (* The tree builder requested a non-Data state for the next scan; the last start tag emitted is the appropriate end tag. In fragment parsing no start tag has been seen, so no end tag ever matches. *) -let scan_raw_state scanner state = +let scan_raw_state scanner state foreign = let data = scanner.data in let start = !(scanner.p) in if start >= !(scanner.eof) then scanner.finished <- true @@ -298,7 +298,9 @@ let scan_raw_state scanner state = body.Raw_text.next end else begin - let body = Raw_text.scan data start name in + let body = + Raw_text.scan ~drop_end_tag_candidate:foreign data start name + in emit scanner (String body.Raw_text.text); if body.Raw_text.had_end_tag then emit scanner (End (make_tag name [])); @@ -332,7 +334,7 @@ let rec next scanner (state : Html_tokenizer.state) foreign else if state <> Data then begin scanner.read <- 0; scanner.write <- 0; - scan_raw_state scanner state; + scan_raw_state scanner state foreign; next scanner Data foreign location end else begin diff --git a/src/lite/raw_text.ml b/src/lite/raw_text.ml index 1c45275..6e8fe95 100644 --- a/src/lite/raw_text.ml +++ b/src/lite/raw_text.ml @@ -27,7 +27,7 @@ let plaintext data start = done; { text = Buffer.contents buffer; had_end_tag = false; next = length } -let scan data start tag = +let scan ?(drop_end_tag_candidate = false) data start tag = let length = String.length data in let decode = match tag with "title" | "textarea" -> true | _ -> false in let buffer = Buffer.create 256 in @@ -129,13 +129,15 @@ let scan data start tag = if index < length && is_letter data.[index] then end_tag_name state lt (index + 1) else begin - Buffer.add_string buffer "</"; + Buffer.add_string buffer + (if index >= length && drop_end_tag_candidate then "<" else "</"); state index end and end_tag_name state lt index = let appropriate () = word_is (lt + 2) index tag in let dump () = - Buffer.add_substring buffer data lt (index - lt); + if drop_end_tag_candidate then Buffer.add_char buffer '<' + else Buffer.add_substring buffer data lt (index - lt); state index in if index >= length then dump () diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 8f846e3..0768121 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -207,14 +207,17 @@ let () = agrees "p b p" "<p><b><p>\x00"; agrees "li s li" "<li><s><li>\x00<p"; ]; - "known divergence: fragment breakout rawtext eof" + "fragment breakout rawtext eof" >::: [ - disagrees ~context:(`Fragment "svg") "style slash" + agrees ~context:(`Fragment "svg") "style slash" "<p></p><style></"; - disagrees ~context:(`Fragment "svg") "script candidate" + agrees ~context:(`Fragment "svg") "script candidate" "<p></p><script></x"; - disagrees ~context:(`Fragment "math") "style candidate" + agrees ~context:(`Fragment "math") "style candidate" "<p></p><style></x"; + agrees "document candidate" "<style></x"; + agrees ~context:(`Fragment "svg") "complete candidate" + "<p></p><style></x>"; ]; "known non-termination" >::: [ terminates ]; ]) From 1d70542910bdfb0d38ae1049a6d01996f18086e1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 23:51:33 +0000 Subject: [PATCH 070/109] Lowercase the doctype keyword lookahead pushback like baseline --- src/lite/markup_declaration.ml | 53 +++++++++++++++++++++++++---- src/lite/ragel_html_tokenizer.ml | 20 ++++++++++- src/lite/ragel_html_tokenizer.ml.rl | 20 ++++++++++- test/lite/lite_fuzz_regression.ml | 20 +++++++++++ 4 files changed, 105 insertions(+), 8 deletions(-) diff --git a/src/lite/markup_declaration.ml b/src/lite/markup_declaration.ml index 1c95b4d..87858c3 100644 --- a/src/lite/markup_declaration.ml +++ b/src/lite/markup_declaration.ml @@ -8,7 +8,14 @@ open Common -type result = { token : Html_tokenizer.token; next : int } +type result = { + token : Html_tokenizer.token; + next : int; + (* Byte count after [next] that the caller must ASCII-lowercase in the + input, mirroring baseline's lowercased pushback of the six-codepoint + PUBLIC/SYSTEM lookahead. *) + lowercase : int; +} let u_rep_utf_8 = "\xEF\xBF\xBD" @@ -44,13 +51,14 @@ let bogus_comment data start = let buffer = Buffer.create 32 in let rec consume index = if index >= length then - { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index } + { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index; lowercase = 0 } else match data.[index] with | '>' -> { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index + 1; + lowercase = 0; } | byte -> add buffer byte; @@ -62,7 +70,7 @@ let comment data start = let length = String.length data in let buffer = Buffer.create 64 in let finish index = - { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index } + { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index; lowercase = 0 } in let rec comment_start index = if index >= length then finish index @@ -134,6 +142,7 @@ let doctype data start = let public_identifier = ref None in let system_identifier = ref None in let quirks = ref false in + let lowercase = ref 0 in let add_to field byte = let buffer = match !field with @@ -154,7 +163,7 @@ let doctype data start = in { token = - Html_tokenizer.Doctype + `Doctype { doctype_name = contents name; public_identifier = contents public_identifier; @@ -163,6 +172,7 @@ let doctype data start = force_quirks = !quirks; }; next = index; + lowercase = !lowercase; } in let rec doctype_start index = @@ -201,7 +211,36 @@ let doctype data start = after_system_keyword (index + 6) else begin quirks := true; - bogus index + (* Baseline reads the keyword lookahead as six codepoints and pushes + it back lowercased (after_doctype_name_state), so window bytes + past a terminating '>' come back lowercased. *) + let rec window_end count index = + if count = 0 || index >= length then index + else + let width = + if data.[index] < '\x80' then 1 + else if data.[index] < '\xE0' then 2 + else if data.[index] < '\xF0' then 3 + else 4 + in + window_end (count - 1) (min length (index + width)) + in + let window_end = window_end 6 index in + let rec find_gt index = + if index >= window_end then None + else if data.[index] = '>' then Some index + else find_gt (index + 1) + in + match find_gt index with + | None -> bogus window_end + | Some gt -> + let rec has_upper index = + index < window_end + && (('A' <= data.[index] && data.[index] <= 'Z') + || has_upper (index + 1)) + in + if has_upper (gt + 1) then lowercase := window_end - (gt + 1); + finish (gt + 1) end and after_public_keyword index = if index >= length then finish ~force_quirks:true index @@ -320,7 +359,9 @@ let doctype data start = let cdata data start = let length = String.length data in let buffer = Buffer.create 64 in - let finish next = { token = `String (Buffer.contents buffer); next } in + let finish next = + { token = Html_tokenizer.String (Buffer.contents buffer); next; lowercase = 0 } + in let rec consume index = if index >= length then finish index else if diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index e3e967d..3a9f689 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -13,7 +13,9 @@ type location_out = { } type t = { - data : string; + mutable data : string; + (* Whether [data] is a private copy that may be mutated in place. *) + mutable data_owned : bool; cs : int ref; p : int ref; pe : int ref; @@ -126,6 +128,7 @@ begin end; let length = String.length data in {data; + data_owned = false; cs; p = ref 0; pe = ref length; @@ -233,6 +236,21 @@ else if scanner.declaration >= 0 then begin for index = start to result.Markup_declaration.next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 done; + if result.Markup_declaration.lowercase > 0 then begin + let bytes = + if scanner.data_owned then Bytes.unsafe_of_string scanner.data + else begin + let copy = Bytes.of_string scanner.data in + scanner.data <- Bytes.unsafe_to_string copy; + scanner.data_owned <- true; + copy + end + in + let next = result.Markup_declaration.next in + for index = next to next + result.Markup_declaration.lowercase - 1 do + Bytes.set bytes index (Char.lowercase_ascii (Bytes.get bytes index)) + done + end; p := result.Markup_declaration.next; cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 21ce17d..606d344 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -13,7 +13,9 @@ type location_out = { } type t = { - data : string; + mutable data : string; + (* Whether [data] is a private copy that may be mutated in place. *) + mutable data_owned : bool; cs : int ref; p : int ref; pe : int ref; @@ -150,6 +152,7 @@ let create data = %%write init; let length = String.length data in {data; + data_owned = false; cs; p = ref 0; pe = ref length; @@ -257,6 +260,21 @@ let run scanner foreign = for index = start to result.Markup_declaration.next - 1 do if data.[index] = '\n' then scanner.line <- scanner.line + 1 done; + if result.Markup_declaration.lowercase > 0 then begin + let bytes = + if scanner.data_owned then Bytes.unsafe_of_string scanner.data + else begin + let copy = Bytes.of_string scanner.data in + scanner.data <- Bytes.unsafe_to_string copy; + scanner.data_owned <- true; + copy + end + in + let next = result.Markup_declaration.next in + for index = next to next + result.Markup_declaration.lowercase - 1 do + Bytes.set bytes index (Char.lowercase_ascii (Bytes.get bytes index)) + done + end; p := result.Markup_declaration.next; cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true diff --git a/test/lite/lite_fuzz_regression.ml b/test/lite/lite_fuzz_regression.ml index 2fd6f8a..b5ac63c 100644 --- a/test/lite/lite_fuzz_regression.ml +++ b/test/lite/lite_fuzz_regression.ml @@ -84,6 +84,24 @@ let tree_builder_failures = "<table><td><b><table><td><svg></td><script></script><><tr/><tr><td><svg></td></tr>M<P></b>"; ] +let doctype_lookahead_failures = + [ + ("keyword mismatch tail lowercased", "<!doctype a b>XYZw"); + ("fuzzer case", "<!doctype hte html>L~tmlml><stml><he"); + ("multibyte window", "<!doctype a X\xc3\xa9>ABCD"); + ("entity started in window", "<!doctype a b>&LT;a"); + ] + |> List.map (fun (name, html) -> agrees name html) + +let doctype_lookahead_guards = + [ + ("public keyword", "<!doctype a public 'x'>YZ"); + ("gt outside window", "<!doctype a bcdefgh>XY"); + ("eof inside window", "<!doctype a b>X"); + ("lowercase tail", "<!doctype a b>xyz<B>T"); + ] + |> List.map (fun (name, html) -> agrees name html) + let () = run_test_tt_main ("Lite fuzz regressions" @@ -93,4 +111,6 @@ let () = "entity chunk fallback" >::: entity_failures; "entity guards" >::: entity_guards; "tree-builder invariants" >::: tree_builder_failures; + "doctype keyword lookahead" >::: doctype_lookahead_failures; + "doctype lookahead guards" >::: doctype_lookahead_guards; ]) From 1d61a91a2e9a255bfda2a50ceb57eae7ad63f72c Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 23:59:07 +0000 Subject: [PATCH 071/109] Drop rawtext end-tag candidates only when baseline's state reset fires --- src/lite/html_parser.ml | 28 ++++++++++++++++++++++++---- src/lite/ragel_html_tokenizer.ml | 12 ++++++------ src/lite/ragel_html_tokenizer.ml.rl | 12 ++++++------ src/lite/ragel_html_tokenizer.mli | 7 ++++++- src/lite/token_source.ml | 6 ++++-- src/lite/token_source.mli | 9 ++++++++- test/lite/lite_fuzz_regression.ml | 18 ++++++++++++++++++ 7 files changed, 72 insertions(+), 20 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index 886e2bd..996d76d 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -686,6 +686,8 @@ module Subtree : sig val adoption_agency_algorithm : t -> Active.t -> location -> string -> bool * (location * Error.t) list + + val buffering : t -> bool end = struct type t = { open_elements : Stack.t; @@ -740,6 +742,8 @@ end = struct subtree_buffer.position <- element; subtree_buffer.enabled <- true + let buffering subtree_buffer = subtree_buffer.enabled + let disable subtree_buffer = let _, depth_limit = subtree_buffer.open_elements in let rec traverse depth acc = function @@ -985,11 +989,14 @@ end let parse ?depth_limit requested_context report tokens = let context = Context.uninitialized () in let tokenizer_state = ref Data in + let tokenizer_drop_candidate = ref false in let token_location = Token_source.location () in let next_token tokens = let state = !tokenizer_state in if state <> Data then tokenizer_state := Data; - let token = Token_source.next tokens state token_location in + let drop_candidate = !tokenizer_drop_candidate in + if drop_candidate then tokenizer_drop_candidate := false; + let token = Token_source.next tokens state ~drop_candidate token_location in ((token_location.line, token_location.column), token) in let push = Token_source.push in @@ -1470,6 +1477,7 @@ let parse ?depth_limit requested_context report tokens = | l, Start ({ name = "script" } as t) -> push_and_emit l t (fun () -> set_tokenizer_state Script_data; + set_drop_candidate true; text_mode mode) | l, End { name = "head" } -> pop l after_head_mode | l, Start ({ name = "template" } as t) -> @@ -1930,6 +1938,7 @@ let parse ?depth_limit requested_context report tokens = frameset_ok := false; push_and_emit l t (fun () -> set_tokenizer_state RCDATA; + set_drop_candidate true; match next_token tokens with | _, Char 0x000A -> text_mode mode | loc, String s when String.starts_with ~prefix:"\n" s -> @@ -1943,7 +1952,7 @@ let parse ?depth_limit requested_context report tokens = frameset_ok := false; close_current_p_element l (fun () -> reconstruct_active_formatting_elements (fun () -> - parse_rawtext mode)) + parse_rawtext ~emitted:false mode)) | l, Start ({ name = "iframe" } as t) -> frameset_ok := false; push_and_emit l t (fun () -> parse_rawtext mode) @@ -2048,13 +2057,24 @@ let parse ?depth_limit requested_context report tokens = | _ -> text_mode original_mode end (* 8.2.5.2. *) - and parse_rcdata original_mode = + and parse_rcdata ?(emitted = true) original_mode = set_tokenizer_state RCDATA; + set_drop_candidate emitted; text_mode original_mode (* 8.2.5.2. *) - and parse_rawtext original_mode = + and parse_rawtext ?(emitted = true) original_mode = set_tokenizer_state RAWTEXT; + set_drop_candidate emitted; text_mode original_mode + (* Baseline resets the tokenizer state per character while its stale + [current_mode] is the closure entering a text state and characters + dispatch to foreign content, discarding a pending end-tag candidate + after its '<'. That configuration is decided here: the closure is + stale-reachable only when the start tag's emission updated + [current_mode]. *) + and set_drop_candidate emitted = + tokenizer_drop_candidate := + emitted && not (Subtree.buffering subtree_buffer) and anything_else_in_table mode ((l, _) as v) = report l (`Bad_content "table") !throw (fun () -> in_body_mode_rules "table" mode v) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 3a9f689..1002df0 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -613,7 +613,7 @@ end (* The tree builder requested a non-Data state for the next scan; the last start tag emitted is the appropriate end tag. In fragment parsing no start tag has been seen, so no end tag ever matches. *) -let scan_raw_state scanner state foreign = +let scan_raw_state scanner state drop_candidate = let data = scanner.data in let start = !(scanner.p) in if start >= !(scanner.eof) then scanner.finished <- true @@ -638,7 +638,7 @@ else begin end else begin let body = - Raw_text.scan ~drop_end_tag_candidate:foreign data start name + Raw_text.scan ~drop_end_tag_candidate:drop_candidate data start name in emit scanner (String body.Raw_text.text); if body.Raw_text.had_end_tag then @@ -654,7 +654,7 @@ else begin if next_index >= !(scanner.eof) then scanner.finished <- true end -let rec next scanner (state : Html_tokenizer.state) foreign +let rec next scanner (state : Html_tokenizer.state) foreign ~drop_candidate (location : location_out) = if scanner.read < scanner.write then begin let index = scanner.read in @@ -673,12 +673,12 @@ end else if state <> Data then begin scanner.read <- 0; scanner.write <- 0; - scan_raw_state scanner state foreign; - next scanner Data foreign location + scan_raw_state scanner state (foreign && drop_candidate); + next scanner Data foreign ~drop_candidate location end else begin scanner.read <- 0; scanner.write <- 0; run scanner foreign; - next scanner state foreign location + next scanner state foreign ~drop_candidate location end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 606d344..50b17fb 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -292,7 +292,7 @@ let run scanner foreign = (* The tree builder requested a non-Data state for the next scan; the last start tag emitted is the appropriate end tag. In fragment parsing no start tag has been seen, so no end tag ever matches. *) -let scan_raw_state scanner state foreign = +let scan_raw_state scanner state drop_candidate = let data = scanner.data in let start = !(scanner.p) in if start >= !(scanner.eof) then scanner.finished <- true @@ -317,7 +317,7 @@ let scan_raw_state scanner state foreign = end else begin let body = - Raw_text.scan ~drop_end_tag_candidate:foreign data start name + Raw_text.scan ~drop_end_tag_candidate:drop_candidate data start name in emit scanner (String body.Raw_text.text); if body.Raw_text.had_end_tag then @@ -333,7 +333,7 @@ let scan_raw_state scanner state foreign = if next_index >= !(scanner.eof) then scanner.finished <- true end -let rec next scanner (state : Html_tokenizer.state) foreign +let rec next scanner (state : Html_tokenizer.state) foreign ~drop_candidate (location : location_out) = if scanner.read < scanner.write then begin let index = scanner.read in @@ -352,12 +352,12 @@ let rec next scanner (state : Html_tokenizer.state) foreign else if state <> Data then begin scanner.read <- 0; scanner.write <- 0; - scan_raw_state scanner state foreign; - next scanner Data foreign location + scan_raw_state scanner state (foreign && drop_candidate); + next scanner Data foreign ~drop_candidate location end else begin scanner.read <- 0; scanner.write <- 0; run scanner foreign; - next scanner state foreign location + next scanner state foreign ~drop_candidate location end diff --git a/src/lite/ragel_html_tokenizer.mli b/src/lite/ragel_html_tokenizer.mli index 96cf1f4..62316e5 100644 --- a/src/lite/ragel_html_tokenizer.mli +++ b/src/lite/ragel_html_tokenizer.mli @@ -7,4 +7,9 @@ type t val create : string -> t val next : - t -> Html_tokenizer.state -> bool -> location_out -> Html_tokenizer.token + t -> + Html_tokenizer.state -> + bool -> + drop_candidate:bool -> + location_out -> + Html_tokenizer.token diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index ebd081b..5328b4d 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -71,14 +71,16 @@ let create html = let location () = { line = 1; column = -1 } -let next source state (out : location_out) = +let next source state ~drop_candidate (out : location_out) = match source.pushed with | { token; line; column } :: rest -> source.pushed <- rest; out.line <- line; out.column <- column; token - | [] -> Ragel_html_tokenizer.next source.scanner state (source.foreign ()) out + | [] -> + Ragel_html_tokenizer.next source.scanner state (source.foreign ()) + ~drop_candidate out let set_foreign source foreign = source.foreign <- foreign diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli index 563425e..4e64bbf 100644 --- a/src/lite/token_source.mli +++ b/src/lite/token_source.mli @@ -8,6 +8,13 @@ type t val create : string -> t val location : unit -> location_out -val next : t -> Html_tokenizer.state -> location_out -> Html_tokenizer.token + +val next : + t -> + Html_tokenizer.state -> + drop_candidate:bool -> + location_out -> + Html_tokenizer.token + val set_foreign : t -> (unit -> bool) -> unit val push : t -> location * Html_tokenizer.token -> unit diff --git a/test/lite/lite_fuzz_regression.ml b/test/lite/lite_fuzz_regression.ml index b5ac63c..1048045 100644 --- a/test/lite/lite_fuzz_regression.ml +++ b/test/lite/lite_fuzz_regression.ml @@ -84,6 +84,22 @@ let tree_builder_failures = "<table><td><b><table><td><svg></td><script></script><><tr/><tr><td><svg></td></tr>M<P></b>"; ] +let candidate_recovery_failures = + [ + ("dropped xmp empty candidate", "<math><mo><Xmp></"); + ("dropped xmp named candidate", "<math><mo><xmp></x"); + ("dropped xmp mid-stream candidate", "<math><mo><xmp></b>c"); + ] + |> List.map (fun (name, html) -> agrees name html) + +let candidate_recovery_guards = + [ + ("emitted rawtext element in foreign", "<math><mo><style></x"); + ("emitted rawtext element in html", "<div><style></x"); + ("emitted rcdata element in foreign", "<math><mo><title></x"); + ] + |> List.map (fun (name, html) -> agrees name html) + let doctype_lookahead_failures = [ ("keyword mismatch tail lowercased", "<!doctype a b>XYZw"); @@ -113,4 +129,6 @@ let () = "tree-builder invariants" >::: tree_builder_failures; "doctype keyword lookahead" >::: doctype_lookahead_failures; "doctype lookahead guards" >::: doctype_lookahead_guards; + "end-tag candidate recovery" >::: candidate_recovery_failures; + "end-tag candidate guards" >::: candidate_recovery_guards; ]) From f07f8abbb8da4153a5b0cf7201a88412edd3057d Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:45:41 -0400 Subject: [PATCH 072/109] Add Lite parser token entry point --- src/lite/html_parser.ml | 4 +-- src/lite/markup_declaration.ml | 2 +- src/lite/markup_lite.ml | 50 ++++++++++++++++++++++++++++------ src/lite/markup_lite.mli | 24 ++++++++++++++++ src/lite/token_source.ml | 10 +++++++ src/lite/token_source.mli | 1 + 6 files changed, 79 insertions(+), 12 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index 996d76d..2112902 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -7,7 +7,7 @@ open Html_tokenizer open Kstream (* Namespaces for pattern matching. *) -type ns = HTML | MathML | SVG | Other of string +type ns = HTML | MathML | SVG | Other of string [@@warning "-37"] type qname = ns * string module Ns : sig @@ -121,7 +121,7 @@ module Context : sig val element : t -> element option val token : t -> string option end = struct - let detect tokens throw k = + let[@warning "-32"] detect tokens throw k = let tokens, restore = checkpoint tokens in let last_name = ref None in diff --git a/src/lite/markup_declaration.ml b/src/lite/markup_declaration.ml index 87858c3..b5fc043 100644 --- a/src/lite/markup_declaration.ml +++ b/src/lite/markup_declaration.ml @@ -163,7 +163,7 @@ let doctype data start = in { token = - `Doctype + Html_tokenizer.Doctype { doctype_name = contents name; public_identifier = contents public_identifier; diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index ad44639..c9640fd 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -23,24 +23,56 @@ type doctype = Markup_common.doctype = { type signal = Markup_common.signal +module Token_tag = Common.Token_tag + +type token = + [ `Doctype of doctype + | `Start of Token_tag.t + | `End of Token_tag.t + | `Char of int + | `String of string + | `Comment of string + | `EOF ] + module Error = Markup_common.Error module Ns = Markup_common.Ns let signal_to_string = Markup_common.signal_to_string +let wrap_report report location error throw resume = + match report location error with + | () -> resume () + | exception exn -> throw exn + +let parse_source report context depth_limit tokens = + Html_parser.parse ?depth_limit context (wrap_report report) tokens + |> Kstream.map (fun (_, signal) _ continue -> continue signal) + |> Markup_common.Stream.Private.to_stream + |> fun stream -> (stream : (signal, sync) stream) + let parse_html ?(report = fun _ _ -> ()) ?(context : [ `Document | `Fragment of string ] = `Document) ?depth_limit html = - let report location error throw resume = - match report location error with - | () -> resume () - | exception exn -> throw exn + Token_source.create html |> parse_source report context depth_limit + +let parse_tokens ?(report = fun _ _ -> ()) + ?(context : [ `Document | `Fragment of string ] = `Document) ?depth_limit + tokens = + let adapt (location, token) = + let token = + match token with + | `Doctype d -> Html_tokenizer.Doctype d + | `Start t -> Html_tokenizer.Start t + | `End t -> Html_tokenizer.End t + | `Char c -> Html_tokenizer.Char c + | `String s -> Html_tokenizer.String s + | `Comment s -> Html_tokenizer.Comment s + | `EOF -> Html_tokenizer.EOF + in + (location, token) in - let tokens = Token_source.create html in - Html_parser.parse ?depth_limit context report tokens - |> Kstream.map (fun (_, signal) _ continue -> continue signal) - |> Markup_common.Stream.Private.to_stream - |> fun stream -> (stream : (signal, sync) stream) + tokens |> List.map adapt |> Token_source.of_tokens + |> parse_source report context depth_limit let iter f stream = stream |> Markup_common.Stream.Private.of_stream diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index b2ad99d..e12366e 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -25,6 +25,23 @@ type doctype = Markup_common.doctype = { type signal = Markup_common.signal +module Token_tag : sig + type t = { + name : string; + attributes : (string * string) list; + self_closing : bool; + } +end + +type token = + [ `Doctype of doctype + | `Start of Token_tag.t + | `End of Token_tag.t + | `Char of int + | `String of string + | `Comment of string + | `EOF ] + module Error = Markup_common.Error module Ns = Markup_common.Ns @@ -37,6 +54,13 @@ val parse_html : string -> (signal, sync) stream +val parse_tokens : + ?report:(location -> Error.t -> unit) -> + ?context:[ `Document | `Fragment of string ] -> + ?depth_limit:int -> + (location * token) list -> + (signal, sync) stream + val iter : ('a -> unit) -> ('a, sync) stream -> unit val write_html : diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 5328b4d..01e24a1 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -69,6 +69,16 @@ let create html = foreign = (fun () -> false); } +let of_tokens tokens = + let pushed = + List.map (fun ((line, column), token) -> { token; line; column }) tokens + in + { + scanner = Ragel_html_tokenizer.create ""; + pushed; + foreign = (fun () -> false); + } + let location () = { line = 1; column = -1 } let next source state ~drop_candidate (out : location_out) = diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli index 4e64bbf..a3f0b82 100644 --- a/src/lite/token_source.mli +++ b/src/lite/token_source.mli @@ -7,6 +7,7 @@ type location_out = { mutable line : int; mutable column : int } type t val create : string -> t +val of_tokens : (location * Html_tokenizer.token) list -> t val location : unit -> location_out val next : From 7b662699c521fd8ac7b3295517ab1594a64937fb Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:47:31 -0400 Subject: [PATCH 073/109] Add strict HtmlStream parser comparison --- test/lite/dune | 7 +- test/lite/lite_parser_diff_corpus.ml | 113 +++++++++++++++++++++++++++ test/lite/oracle.ml | 44 ++++++++++- 3 files changed, 159 insertions(+), 5 deletions(-) create mode 100644 test/lite/lite_parser_diff_corpus.ml diff --git a/test/lite/dune b/test/lite/dune index 4d69826..8432b6a 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -2,13 +2,18 @@ (name lite_test_oracle) (wrapped false) (modules oracle) - (libraries devkit markup)) + (libraries devkit markup markup.lite)) (executable (name lite_diff_corpus) (modules lite_diff_corpus) (libraries containers lite_test_oracle markup markup.lite unix)) +(executable + (name lite_parser_diff_corpus) + (modules lite_parser_diff_corpus) + (libraries containers lite_test_oracle markup markup.lite unix)) + (executable (name lite_count_corpus) (modules lite_count_corpus) diff --git a/test/lite/lite_parser_diff_corpus.ml b/test/lite/lite_parser_diff_corpus.ml new file mode 100644 index 0000000..a2db8c4 --- /dev/null +++ b/test/lite/lite_parser_diff_corpus.ml @@ -0,0 +1,113 @@ +let usage program = + Printf.eprintf "Usage: %s DIRECTORY\n" program; + exit 2 + +let html_files directory = + let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in + let rec collect acc = + match files () with + | None -> List.sort String.compare acc + | Some path -> + let path = CCIO.File.to_string path in + collect + (if Filename.check_suffix path ".html" then path :: acc else acc) + in + collect [] + +let collect iter stream = + let values = ref [] in + iter (fun value -> values := value :: !values) stream; + List.rev !values + +exception Timeout + +type result = + | Parsed of + Markup_common.signal list + * (Markup_common.location * Markup_common.Error.t) list + | Raised of string * (Markup_common.location * Markup_common.Error.t) list + +let with_timeout f = + let previous = + Sys.signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout)) + in + ignore (Unix.alarm 2); + Fun.protect + ~finally:(fun () -> + ignore (Unix.alarm 0); + Sys.set_signal Sys.sigalrm previous) + f + +let run parse collect_signals = + let errors = ref [] in + let report location error = errors := (location, error) :: !errors in + try + Parsed + (with_timeout (fun () -> collect_signals (parse report)), List.rev !errors) + with exn -> Raised (Printexc.to_string exn, List.rev !errors) + +let compare name baseline lite = + if baseline <> lite then begin + Printf.eprintf "%s: strict parser mismatch\n" name; + false + end + else true + +let contexts = + [ + ("document", `Document); + ("div-fragment", `Fragment "div"); + ("table-fragment", `Fragment "table"); + ("svg-fragment", `Fragment "svg"); + ("math-fragment", `Fragment "math"); + ] + +let check path html = + (* Adapt exactly once. Both parsers receive values derived from this list. *) + let tokens = Oracle.adapt html in + List.for_all + (fun (context_name, context) -> + List.for_all + (fun depth_limit -> + let suffix = + match depth_limit with + | None -> context_name + | Some n -> Printf.sprintf "%s/depth-%d" context_name n + in + let baseline = + run + (fun report -> + Oracle.parse_adapted ?depth_limit ~context report tokens) + (collect Markup.iter) + in + let lite = + run + (fun report -> + Oracle.parse_lite_adapted ?depth_limit ~context report tokens) + (collect Markup_lite.iter) + in + compare (path ^ ":" ^ suffix) baseline lite) + [ None; Some 1; Some 8 ]) + contexts + +let () = + let directory = + match Array.to_list Sys.argv with + | [ _; directory ] -> directory + | _ -> usage Sys.argv.(0) + in + let files = html_files directory in + if files = [] then usage Sys.argv.(0); + let failures = ref 0 in + List.iteri + (fun index path -> + if not (check path (CCIO.File.read_exn (CCIO.File.make path))) then + incr failures; + if (index + 1) mod 100 = 0 then + Printf.eprintf "checked %d/%d\r%!" (index + 1) (List.length files)) + files; + Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files); + if !failures <> 0 then begin + Printf.eprintf "FAILED: %d files differed\n" !failures; + exit 1 + end diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index 5b62f01..a0b0612 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -4,7 +4,11 @@ let decode raw = let inner = HS.Raw.project raw in try Devkit.Web.htmldecode inner with _ -> inner -let tokenize html : (Markup.location * Markup.Internals.token) list = +(* HtmlStream does not expose comments, self-closing syntax, raw-text token + boundaries, or columns. The strict parser oracle therefore omits comments, + defaults [self_closing] to false, expands Script/Style into three tokens, + and uses [(line, -1)] for both parsers. *) +let adapt html : (Markup.location * Markup.Internals.token) list = let ctx = HS.init () in let tokens = ref [] in let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in @@ -32,8 +36,40 @@ let tokenize html : (Markup.location * Markup.Internals.token) list = emit `EOF; List.rev !tokens -let parse ?depth_limit - ?(context : [ `Document | `Fragment of string ] = `Document) report html = - html |> tokenize +let lite_tokens tokens : (Markup_lite.location * Markup_lite.token) list = + let tag (tag : Markup.Internals.Token_tag.t) : Markup_lite.Token_tag.t = + { + name = tag.name; + attributes = tag.attributes; + self_closing = tag.self_closing; + } + in + List.map + (fun (location, token) -> + let token : Markup_lite.token = + match token with + | `Doctype d -> `Doctype d + | `Start t -> `Start (tag t) + | `End t -> `End (tag t) + | `Char c -> `Char c + | `String s -> `String s + | `Comment s -> `Comment s + | `EOF -> `EOF + in + (location, token)) + tokens + +let parse_adapted ?depth_limit + ?(context : [ `Document | `Fragment of string ] = `Document) report tokens = + tokens |> Markup.Internals.parse_tokens ?depth_limit ~report ~context |> Markup.signals + +let parse_lite_adapted ?depth_limit + ?(context : [ `Document | `Fragment of string ] = `Document) report tokens = + tokens |> lite_tokens + |> Markup_lite.parse_tokens ?depth_limit ~report ~context + +let parse ?depth_limit + ?(context : [ `Document | `Fragment of string ] = `Document) report html = + html |> adapt |> parse_adapted ?depth_limit ~context report From 2f2b12516e27c6c37daf2a20f197880a42107ce4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:47:59 -0400 Subject: [PATCH 074/109] Fuzz strict adapted parser streams --- test/fuzz/lite_diff_fuzz.ml | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/test/fuzz/lite_diff_fuzz.ml b/test/fuzz/lite_diff_fuzz.ml index e02b0e2..06aa741 100644 --- a/test/fuzz/lite_diff_fuzz.ml +++ b/test/fuzz/lite_diff_fuzz.ml @@ -48,23 +48,22 @@ type outcome = | Signals of Markup_common.signal list * errors | Raised of string * errors -let run parse collect_signals context input = +let run parse collect_signals = let errors = ref [] in let report location error = errors := (location, error) :: !errors in - try Signals (collect_signals (parse report context input), List.rev !errors) + try Signals (collect_signals (parse report), List.rev !errors) with exn -> Raised (Printexc.to_string exn, List.rev !errors) -let oracle context input = +let oracle context tokens = run - (fun report context input -> - Oracle.parse ~depth_limit ~context report input) - (collect Markup.iter) context input + (fun report -> Oracle.parse_adapted ~depth_limit ~context report tokens) + (collect Markup.iter) -let lite context input = +let lite context tokens = run - (fun report context input -> - Markup_lite.parse_html ~report ~context ~depth_limit input) - (collect Markup_lite.iter) context input + (fun report -> + Oracle.parse_lite_adapted ~depth_limit ~context report tokens) + (collect Markup_lite.iter) let truncate string = let maximum = 240 in @@ -110,7 +109,9 @@ let compare_errors = compare_lists "error" error let check input = let context, body = context_of_input input in - match (oracle context body, lite context body) with + (* HtmlStream adaptation is intentionally performed once. *) + let tokens = Oracle.adapt body in + match (oracle context tokens, lite context tokens) with | Signals (expected, expected_errors), Signals (actual, actual_errors) -> compare_signals expected actual; compare_errors expected_errors actual_errors @@ -123,5 +124,4 @@ let check input = | Signals _, Raised (exception_, _) -> crash "Lite raised but oracle returned signals: %S" exception_ -let () = - match read_input stdin with Some input -> check input | None -> () +let () = match read_input stdin with Some input -> check input | None -> () From f9956b099197d577dab2c29b758dcc364a2a1e9e Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:49:24 -0400 Subject: [PATCH 075/109] Restore stable generated Lite scanner --- src/lite/ragel_html_tokenizer.ml | 1613 ++++++++++++++++++------------ 1 file changed, 964 insertions(+), 649 deletions(-) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 1002df0..5ef126b 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -1,684 +1,999 @@ (* Derived from Devkit htmlStream_ragel.ml.rl. -Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. -The original source is available from https://github.com/ygrek/ocaml-webstack. *) + Devkit is distributed under LGPL-2.1-only with the OCaml linking exception. + The original source is available from https://github.com/ygrek/ocaml-webstack. *) [@@@ocaml.warning "-38-32"] open Common open Html_tokenizer -type location_out = { - mutable line : int; - mutable column : int; -} +type location_out = { mutable line : int; mutable column : int } type t = { - mutable data : string; - (* Whether [data] is a private copy that may be mutated in place. *) - mutable data_owned : bool; - cs : int ref; - p : int ref; - pe : int ref; - eof : int ref; - mark : int ref; - tag : string ref; - mutable last_start_tag : string; - mutable declaration : int; - mutable bogus : int; - mutable tag_scan : int; - mutable end_scan : int; - mutable line : int; - tokens : Html_tokenizer.token array; - lines : int array; - mutable read : int; - mutable write : int; - mutable finished : bool; + mutable data : string; + (* Whether [data] is a private copy that may be mutated in place. *) + mutable data_owned : bool; + cs : int ref; + p : int ref; + pe : int ref; + eof : int ref; + mark : int ref; + tag : string ref; + mutable last_start_tag : string; + mutable declaration : int; + mutable bogus : int; + mutable tag_scan : int; + mutable end_scan : int; + mutable line : int; + tokens : Html_tokenizer.token array; + lines : int array; + mutable read : int; + mutable write : int; + mutable finished : bool; } let decode = Html_entity_decoder.decode (* The first occurrence of a name wins, like src/baseline. *) let attributes attrs = -let rec dedupe seen = function -| [] -> [] -| (name, value) :: rest -> -if List.mem name seen then dedupe seen rest -else -(name, Html_entity_decoder.decode_attribute value) -:: dedupe (name :: seen) rest -in -dedupe [] attrs + let rec dedupe seen = function + | [] -> [] + | (name, value) :: rest -> + if List.mem name seen then dedupe seen rest + else + (name, Html_entity_decoder.decode_attribute value) + :: dedupe (name :: seen) rest + in + dedupe [] attrs let make_tag ?(self_closing = false) name attributes = -{Token_tag.name; attributes; self_closing} + { Token_tag.name; attributes; self_closing } let normalize_name text = -let text = String.lowercase_ascii text in -if not (String.contains text '\x00') then text -else begin - let buffer = Buffer.create (String.length text + 8) in - String.iter - (fun byte -> - if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" - else Buffer.add_char buffer byte) - text; - Buffer.contents buffer -end + let text = String.lowercase_ascii text in + if not (String.contains text '\x00') then text + else begin + let buffer = Buffer.create (String.length text + 8) in + String.iter + (fun byte -> + if byte = '\x00' then Buffer.add_string buffer "\xEF\xBF\xBD" + else Buffer.add_char buffer byte) + text; + Buffer.contents buffer + end let buffer_capacity = 128 let maximum_transition_output = 3 let emit scanner token = -scanner.tokens.(scanner.write) <- token; -scanner.lines.(scanner.write) <- scanner.line; -scanner.write <- scanner.write + 1 + scanner.tokens.(scanner.write) <- token; + scanner.lines.(scanner.write) <- scanner.line; + scanner.write <- scanner.write + 1 (* The tree builder treats a leading whitespace run differently from the rest -of a text run in several insertion modes; src/baseline gets this for free -from per-character tokens. *) + of a text run in several insertion modes; src/baseline gets this for free + from per-character tokens. *) let emit_text scanner text = -let length = String.length text in -let rec whitespace_end index = -if index < length then -match text.[index] with -| '\t' | '\n' | '\x0C' | '\r' | ' ' -> whitespace_end (index + 1) -| _ -> index -else index -in -let boundary = whitespace_end 0 in -if boundary = 0 || boundary = length then emit scanner (String text) -else begin - emit scanner (String (String.sub text 0 boundary)); - emit scanner (String (String.sub text boundary (length - boundary))) -end - -let _htmlstream_trans_keys : int array = [| -1; 5; 1; 5; 1; 7; 1; 7; 0; 6; 0; 6; 0 ; -|] -let _htmlstream_char_class : int array = [| -0; 1; 2; 0; 0; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 0; 3; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 4; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 5; 2; 6; 3; 2; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 2; 2; 2; 2; 2; 2; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 7; 0 ; -|] -let _htmlstream_index_offsets : int array = [| -0; 5; 10; 17; 24; 31; 0 ; -|] -let _htmlstream_indices : int array = [| -2; 1; 1; 1; 3; 6; 5; 5; 5; 7; 10; 9; 11; 12; 9; 9; 13; 16; 15; 15; 15; 15; 0; 17; 20; 21; 19; 19; 20; 19; 20; 24; 25; 23; 23; 24; 23; 24; 0 ; -|] -let _htmlstream_index_defaults : int array = [| -1; 5; 9; 15; 19; 23; 0 ; -|] -let _htmlstream_cond_targs : int array = [| -0; 1; 1; 2; 1; 1; 1; 2; 2; 0; 0; 0; 3; 5; 3; 0; 0; 4; 4; 4; 1; 1; 5; 5; 1; 1; 0 ; -|] -let _htmlstream_cond_actions : int array = [| -0; 1; 2; 0; 3; 0; 4; 3; 5; 6; 7; 8; 0; 1; 9; 10; 11; 1; 12; 0; 13; 14; 15; 0; 16; 17; 0 ; -|] -let _htmlstream_eof_trans : int array = [| -1; 5; 9; 15; 19; 23; 0 ; -|] -let htmlstream_start : int = 0 -let htmlstream_first_final : int = 0 -let htmlstream_error : int = -1 -let htmlstream_en_main : int = 0 + let length = String.length text in + let rec whitespace_end index = + if index < length then + match text.[index] with + | '\t' | '\n' | '\x0C' | '\r' | ' ' -> whitespace_end (index + 1) + | _ -> index + else index + in + let boundary = whitespace_end 0 in + if boundary = 0 || boundary = length then emit scanner (String text) + else begin + emit scanner (String (String.sub text 0 boundary)); + emit scanner (String (String.sub text boundary (length - boundary))) + end + +let _htmlstream_trans_keys : int array = + Array.concat [ [| 10; 60; 10; 60; 10; 122; 10; 122; 9; 62; 9; 62; 0 |] ] + +let _htmlstream_key_spans : int array = + Array.concat [ [| 51; 51; 113; 113; 54; 54 |] ] + +let _htmlstream_index_offsets : int array = + Array.concat [ [| 0; 52; 104; 218; 332; 387 |] ] + +let _htmlstream_indicies : int array = + Array.concat + [ + [| + 1; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 0; + 2; + 0; + 4; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 3; + 5; + 3; + 7; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 8; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 9; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 6; + 8; + 6; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 6; + 6; + 6; + 6; + 6; + 6; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 10; + 6; + 12; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 11; + 13; + 11; + 11; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 11; + 11; + 11; + 11; + 11; + 11; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 14; + 11; + 16; + 17; + 15; + 16; + 16; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 16; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 16; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 15; + 16; + 15; + 19; + 20; + 18; + 19; + 19; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 19; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 19; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 18; + 19; + 18; + 0; + |]; + ] + +let _htmlstream_trans_targs : int array = + Array.concat + [ [| 1; 1; 2; 1; 1; 2; 0; 0; 0; 3; 5; 0; 0; 0; 4; 4; 1; 1; 5; 1; 1 |] ] + +let _htmlstream_trans_actions : int array = + Array.concat + [ + [| 1; 2; 0; 0; 4; 3; 6; 7; 8; 0; 1; 10; 11; 0; 1; 0; 13; 14; 0; 16; 17 |]; + ] + +let _htmlstream_eof_actions : int array = + Array.concat [ [| 0; 3; 5; 9; 12; 15 |] ] + +let htmlstream_start : int = 0 +let htmlstream_first_final : int = 0 +let htmlstream_error : int = -1 +let htmlstream_en_main : int = 0 + +type _htmlstream_state = { mutable keys : int; mutable trans : int } + +exception Goto_match_htmlstream +exception Goto_again_htmlstream +exception Goto_eof_trans_htmlstream + let create data = -let cs = ref 0 in -begin - cs := htmlstream_start; - -end; -let length = String.length data in -{data; - data_owned = false; - cs; - p = ref 0; - pe = ref length; - eof = ref length; - mark = ref (-1); - tag = ref ""; - last_start_tag = ""; - declaration = (-1); - bogus = (-1); - tag_scan = (-1); - end_scan = (-1); - line = 1; - tokens = Array.make buffer_capacity EOF; - lines = Array.make buffer_capacity 1; - read = 0; - write = 0; - finished = false} + let cs = ref 0 in + + begin + cs.contents <- htmlstream_start + end; + + let length = String.length data in + { + data; + data_owned = false; + cs; + p = ref 0; + pe = ref length; + eof = ref length; + mark = ref (-1); + tag = ref ""; + last_start_tag = ""; + declaration = -1; + bogus = -1; + tag_scan = -1; + end_scan = -1; + line = 1; + tokens = Array.make buffer_capacity EOF; + lines = Array.make buffer_capacity 1; + read = 0; + write = 0; + finished = false; + } let run scanner foreign = -let data = scanner.data in -let cs = scanner.cs in -let p = scanner.p in -let pe = scanner.pe in -let eof = scanner.eof in -let mark = scanner.mark in -let tag = scanner.tag in -pe := !eof; -let pause () = -if scanner.write >= buffer_capacity - maximum_transition_output && -!p < !eof then -pe := !p + 1 -in -let sub () = -assert (!mark >= 0); -let text = -if !p <= !mark then "" else String.sub data !mark (!p - !mark) -in -mark := -1; -text -in -if scanner.tag_scan >= 0 then begin - let start = scanner.tag_scan in - scanner.tag_scan <- (-1); - let name = !tag in - let result = Tag_attributes.scan data start in - let next = - if not result.Tag_attributes.ok then !eof - else begin - let attrs = attributes result.Tag_attributes.attributes in - let self_closing = result.Tag_attributes.self_closing in - scanner.last_start_tag <- name; - emit scanner (Start (make_tag ~self_closing name attrs)); - result.Tag_attributes.next - end - in - for index = start + 1 to next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true -end -else if scanner.end_scan >= 0 then begin - let start = scanner.end_scan in - scanner.end_scan <- (-1); - let name = !tag in - let result = Tag_attributes.scan data start in - if result.Tag_attributes.ok then - emit scanner (End (make_tag name [])); - let next = - if result.Tag_attributes.ok then result.Tag_attributes.next else !eof - in - for index = start + 1 to next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true -end -else if scanner.bogus >= 0 then begin - let start = scanner.bogus in - scanner.bogus <- (-1); - (* The consumed character is a codepoint, not a byte. *) - let width = - if data.[start] < '\x80' then 1 - else if data.[start] < '\xE0' then 2 - else if data.[start] < '\xF0' then 3 - else 4 - in - let start = min (start + width) !eof in - let result = Markup_declaration.bogus_comment data start in - emit scanner result.Markup_declaration.token; - for index = start to result.Markup_declaration.next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - p := result.Markup_declaration.next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true -end -else if scanner.declaration >= 0 then begin - let start = scanner.declaration in - scanner.declaration <- (-1); - let result = Markup_declaration.scan ~foreign data start in - emit scanner result.Markup_declaration.token; - for index = start to result.Markup_declaration.next - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - if result.Markup_declaration.lowercase > 0 then begin - let bytes = - if scanner.data_owned then Bytes.unsafe_of_string scanner.data - else begin - let copy = Bytes.of_string scanner.data in - scanner.data <- Bytes.unsafe_to_string copy; - scanner.data_owned <- true; - copy - end - in - let next = result.Markup_declaration.next in - for index = next to next + result.Markup_declaration.lowercase - 1 do - Bytes.set bytes index (Char.lowercase_ascii (Bytes.get bytes index)) - done - end; - p := result.Markup_declaration.next; - cs := htmlstream_en_main; - if !p >= !eof then scanner.finished <- true -end -else begin - begin - let _trans : int ref = ref ( 0 ) in - let _keys : int ref = ref 0 in - let _inds : int ref = ref 0 in - let _ic : int ref = ref 0 in - let _have : int ref = ref ( 0 ) in - let _cont : int ref = ref ( 1 ) in - let _again : int ref = ref ( 1 ) in - let _bsc : int ref = ref ( 1 ) in - while _again.contents= 1 && ( p.contents!= pe.contents|| p.contents= eof.contents ) do - begin - _cont := 1; - _again := 1; - if p.contents= eof.contents then - begin - begin - if _htmlstream_eof_trans.(cs.contents)> 0 then - begin - begin - _trans := _htmlstream_eof_trans.(cs.contents)- 1; - - end; - - end - ; - end; - - end - else - begin - begin - _keys := ( cs.contents lsl 1 ); - _inds := _htmlstream_index_offsets.(cs.contents); - if ( Char.code data.[p.contents] )<= 122 && ( Char.code data.[p.contents] )>= 9 then - begin - begin - _ic := _htmlstream_char_class.(( Char.code data.[p.contents] )- 9); - if _ic.contents<= _htmlstream_trans_keys.( _keys.contents+1 )&& _ic.contents>= _htmlstream_trans_keys.( _keys.contents ) then - begin - _trans := _htmlstream_indices.( _inds.contents+ ( _ic.contents- _htmlstream_trans_keys.( _keys.contents ) ) ); - - end - else - begin - _trans := _htmlstream_index_defaults.(cs.contents); - - end - ; - end; - - end - else - begin - begin - _trans := _htmlstream_index_defaults.(cs.contents); - - end; - - end - ; - end; - - end - ;cs := _htmlstream_cond_targs.(_trans.contents); - if _htmlstream_cond_actions.(_trans.contents)!= 0 then - begin - begin - if _htmlstream_cond_actions.(_trans.contents) = 1 then - begin - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 12 then - begin - begin - tag := normalize_name @@ sub (); - scanner.end_scan <- !p; - begin - p := p.contents- 1; - - end; - - pe := !p + 1; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 3 then - begin - begin - emit_text scanner (decode (sub ())); - pause (); - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 15 then - begin - begin - tag := normalize_name @@ sub (); - scanner.tag_scan <- !p; - begin - p := p.contents- 1; - - end; - - pe := !p + 1; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 8 then - begin - begin - scanner.declaration <- !p; pe := !p + 1; - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 10 then - begin - begin - scanner.bogus <- !p; pe := !p + 1; - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 6 then - begin - begin - emit scanner (String "<"); - pause (); - begin - p := p.contents- 1; - - end; - - begin - cs := 0; - - end; - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 5 then - begin - begin - emit scanner (String "<") - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 9 then - begin - begin - emit scanner (String "<"); - emit scanner (String "/") - - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 4 then - begin - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 2 then - begin - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 13 then - begin - begin - tag := normalize_name @@ sub (); - scanner.end_scan <- !p; - begin - p := p.contents- 1; - - end; - - pe := !p + 1; - - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 16 then - begin - begin - tag := normalize_name @@ sub (); - scanner.tag_scan <- !p; - begin - p := p.contents- 1; - - end; - - pe := !p + 1; - - end; - begin - mark := !p - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 11 then - begin - begin - scanner.bogus <- !p; pe := !p + 1; - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 7 then - begin - begin - emit scanner (String "<"); - pause (); - begin - p := p.contents- 1; - - end; - - begin - cs := 0; - - end; - - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 14 then - begin - begin - tag := normalize_name @@ sub (); - scanner.end_scan <- !p; - begin - p := p.contents- 1; - - end; - - pe := !p + 1; - - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - else if _htmlstream_cond_actions.(_trans.contents) = 17 then - begin - begin - tag := normalize_name @@ sub (); - scanner.tag_scan <- !p; - begin - p := p.contents- 1; - - end; - - pe := !p + 1; - - end; - begin - mark := !p - end; - begin - scanner.line <- scanner.line + 1 - end; - - end - ; - - end; - - end - ;if _cont.contents= 1 then - begin - begin - if p.contents= eof.contents then - begin - begin - if cs.contents>= 0 then - begin - begin - _cont := 0; - _again := 0; - - end; - - end - ; - end; - - end - else - begin - begin - p := p.contents + 1; - begin - _cont := 0; - _again := 1; - - end; - - end; - - end - ;if _cont.contents= 1 then - begin - begin - begin - _cont := 0; - _again := 0; - - end; - - end; - - end - ; - end; - - end - ; - end; - - done; - - end; - if - scanner.declaration >= 0 || scanner.bogus >= 0 || scanner.tag_scan >= 0 - || scanner.end_scan >= 0 - then () - else if !p >= !eof then scanner.finished <- true - else if scanner.write = 0 then scanner.finished <- true -end + let data = scanner.data in + let cs = scanner.cs in + let p = scanner.p in + let pe = scanner.pe in + let eof = scanner.eof in + let mark = scanner.mark in + let tag = scanner.tag in + pe := !eof; + let pause () = + if scanner.write >= buffer_capacity - maximum_transition_output && !p < !eof + then pe := !p + 1 + in + let sub () = + assert (!mark >= 0); + let text = if !p <= !mark then "" else String.sub data !mark (!p - !mark) in + mark := -1; + text + in + if scanner.tag_scan >= 0 then begin + let start = scanner.tag_scan in + scanner.tag_scan <- -1; + let name = !tag in + let result = Tag_attributes.scan data start in + let next = + if not result.Tag_attributes.ok then !eof + else begin + let attrs = attributes result.Tag_attributes.attributes in + let self_closing = result.Tag_attributes.self_closing in + scanner.last_start_tag <- name; + emit scanner (Start (make_tag ~self_closing name attrs)); + result.Tag_attributes.next + end + in + for index = start + 1 to next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.end_scan >= 0 then begin + let start = scanner.end_scan in + scanner.end_scan <- -1; + let name = !tag in + let result = Tag_attributes.scan data start in + if result.Tag_attributes.ok then emit scanner (End (make_tag name [])); + let next = + if result.Tag_attributes.ok then result.Tag_attributes.next else !eof + in + for index = start + 1 to next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.bogus >= 0 then begin + let start = scanner.bogus in + scanner.bogus <- -1; + (* The consumed character is a codepoint, not a byte. *) + let width = + if data.[start] < '\x80' then 1 + else if data.[start] < '\xE0' then 2 + else if data.[start] < '\xF0' then 3 + else 4 + in + let start = min (start + width) !eof in + let result = Markup_declaration.bogus_comment data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else if scanner.declaration >= 0 then begin + let start = scanner.declaration in + scanner.declaration <- -1; + let result = Markup_declaration.scan ~foreign data start in + emit scanner result.Markup_declaration.token; + for index = start to result.Markup_declaration.next - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + if result.Markup_declaration.lowercase > 0 then begin + let bytes = + if scanner.data_owned then Bytes.unsafe_of_string scanner.data + else begin + let copy = Bytes.of_string scanner.data in + scanner.data <- Bytes.unsafe_to_string copy; + scanner.data_owned <- true; + copy + end + in + let next = result.Markup_declaration.next in + for index = next to next + result.Markup_declaration.lowercase - 1 do + Bytes.set bytes index (Char.lowercase_ascii (Bytes.get bytes index)) + done + end; + p := result.Markup_declaration.next; + cs := htmlstream_en_main; + if !p >= !eof then scanner.finished <- true + end + else begin + begin + let state = { keys = 0; trans = 0 } in + let rec do_start () = + if p.contents = pe.contents then do_test_eof () else do_resume () + and do_resume () = + begin try + let keys = cs.contents lsl 1 in + let inds = _htmlstream_index_offsets.(cs.contents) in + + let slen = _htmlstream_key_spans.(cs.contents) in + state.trans <- + _htmlstream_indicies.(inds + + + if + slen > 0 + && _htmlstream_trans_keys.(keys) + <= Char.code data.[p.contents] + && Char.code data.[p.contents] + <= _htmlstream_trans_keys.(keys + 1) + then + Char.code data.[p.contents] + - _htmlstream_trans_keys.(keys) + else slen) + with Goto_match_htmlstream -> () + end; + do_eof_trans () + and do_eof_trans () = + cs.contents <- _htmlstream_trans_targs.(state.trans); + + begin try + if _htmlstream_trans_actions.(state.trans) = 0 then + raise_notrace Goto_again_htmlstream; + + match _htmlstream_trans_actions.(state.trans) with + | 1 -> + begin + mark := !p + end; + () + | 3 -> + begin + emit_text scanner (decode (sub ())); + pause () + end; + () + | 8 -> + begin + scanner.declaration <- !p; + pe := !p + 1 + end; + () + | 10 -> + begin + scanner.bogus <- !p; + pe := !p + 1 + end; + () + | 6 -> + begin + emit scanner (String "<"); + pause (); + p.contents <- p.contents - 1; + begin + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream + end + end; + () + | 4 -> + begin + scanner.line <- scanner.line + 1 + end; + () + | 2 -> + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 13 -> + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + begin + mark := !p + end; + () + | 16 -> + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + begin + mark := !p + end; + () + | 11 -> + begin + scanner.bogus <- !p; + pe := !p + 1 + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 7 -> + begin + emit scanner (String "<"); + pause (); + p.contents <- p.contents - 1; + begin + cs.contents <- 0; + if true then raise_notrace Goto_again_htmlstream + end + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 14 -> + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | 17 -> + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + begin + mark := !p + end; + begin + scanner.line <- scanner.line + 1 + end; + () + | _ -> () + with Goto_again_htmlstream -> () + end; + + do_again () + and do_again () = + p.contents <- p.contents + 1; + if p.contents <> pe.contents then do_resume () else do_test_eof () + and do_test_eof () = + if p.contents = eof.contents then + begin try + begin match _htmlstream_eof_actions.(cs.contents) with + | 12 -> + begin + tag := normalize_name @@ sub (); + scanner.end_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + () + | 3 -> + begin + emit_text scanner (decode (sub ())); + pause () + end; + () + | 15 -> + begin + tag := normalize_name @@ sub (); + scanner.tag_scan <- !p; + p.contents <- p.contents - 1; + pe := !p + 1 + end; + () + | 5 -> + begin + emit scanner (String "<") + end; + () + | 9 -> + begin + emit scanner (String "<"); + emit scanner (String "/") + end; + () + | _ -> () + end + with + | Goto_again_htmlstream -> do_again () + | Goto_eof_trans_htmlstream -> do_eof_trans () + end + in + do_start () + end; + + if + scanner.declaration >= 0 || scanner.bogus >= 0 || scanner.tag_scan >= 0 + || scanner.end_scan >= 0 + then () + else if !p >= !eof then scanner.finished <- true + else if scanner.write = 0 then scanner.finished <- true + end (* The tree builder requested a non-Data state for the next scan; the last -start tag emitted is the appropriate end tag. In fragment parsing no start -tag has been seen, so no end tag ever matches. *) + start tag emitted is the appropriate end tag. In fragment parsing no start + tag has been seen, so no end tag ever matches. *) let scan_raw_state scanner state drop_candidate = -let data = scanner.data in -let start = !(scanner.p) in -if start >= !(scanner.eof) then scanner.finished <- true -else begin - let next_index = - match (state : Html_tokenizer.state) with - | PLAINTEXT -> - let body = Raw_text.plaintext data start in - emit scanner (String body.Raw_text.text); - body.Raw_text.next - | _ -> - let name = scanner.last_start_tag in - if name = "" then begin - let body = Raw_text.plaintext data start in - let text = - match (state : Html_tokenizer.state) with - | RCDATA -> decode body.Raw_text.text - | _ -> body.Raw_text.text - in - emit scanner (String text); - body.Raw_text.next - end - else begin - let body = - Raw_text.scan ~drop_end_tag_candidate:drop_candidate data start name - in - emit scanner (String body.Raw_text.text); - if body.Raw_text.had_end_tag then - emit scanner (End (make_tag name [])); - body.Raw_text.next - end - in - for index = start to next_index - 1 do - if data.[index] = '\n' then scanner.line <- scanner.line + 1 - done; - scanner.p := next_index; - scanner.cs := htmlstream_en_main; - if next_index >= !(scanner.eof) then scanner.finished <- true -end + let data = scanner.data in + let start = !(scanner.p) in + if start >= !(scanner.eof) then scanner.finished <- true + else begin + let next_index = + match (state : Html_tokenizer.state) with + | PLAINTEXT -> + let body = Raw_text.plaintext data start in + emit scanner (String body.Raw_text.text); + body.Raw_text.next + | _ -> + let name = scanner.last_start_tag in + if name = "" then begin + let body = Raw_text.plaintext data start in + let text = + match (state : Html_tokenizer.state) with + | RCDATA -> decode body.Raw_text.text + | _ -> body.Raw_text.text + in + emit scanner (String text); + body.Raw_text.next + end + else begin + let body = + Raw_text.scan ~drop_end_tag_candidate:drop_candidate data start + name + in + emit scanner (String body.Raw_text.text); + if body.Raw_text.had_end_tag then + emit scanner (End (make_tag name [])); + body.Raw_text.next + end + in + for index = start to next_index - 1 do + if data.[index] = '\n' then scanner.line <- scanner.line + 1 + done; + scanner.p := next_index; + scanner.cs := htmlstream_en_main; + if next_index >= !(scanner.eof) then scanner.finished <- true + end let rec next scanner (state : Html_tokenizer.state) foreign ~drop_candidate -(location : location_out) = -if scanner.read < scanner.write then begin - let index = scanner.read in - let token = scanner.tokens.(index) in - location.line <- scanner.lines.(index); - location.column <- -1; - scanner.tokens.(index) <- EOF; - scanner.read <- index + 1; - token -end -else if scanner.finished then begin - location.line <- scanner.line; - location.column <- -1; - EOF -end -else if state <> Data then begin - scanner.read <- 0; - scanner.write <- 0; - scan_raw_state scanner state (foreign && drop_candidate); - next scanner Data foreign ~drop_candidate location -end -else begin - scanner.read <- 0; - scanner.write <- 0; - run scanner foreign; - next scanner state foreign ~drop_candidate location -end + (location : location_out) = + if scanner.read < scanner.write then begin + let index = scanner.read in + let token = scanner.tokens.(index) in + location.line <- scanner.lines.(index); + location.column <- -1; + scanner.tokens.(index) <- EOF; + scanner.read <- index + 1; + token + end + else if scanner.finished then begin + location.line <- scanner.line; + location.column <- -1; + EOF + end + else if state <> Data then begin + scanner.read <- 0; + scanner.write <- 0; + scan_raw_state scanner state (foreign && drop_candidate); + next scanner Data foreign ~drop_candidate location + end + else begin + scanner.read <- 0; + scanner.write <- 0; + run scanner foreign; + next scanner state foreign ~drop_candidate location + end From a1a615271f88316ad4432a2944bae709e811cd48 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:49:24 -0400 Subject: [PATCH 076/109] Use baseline native parser for regressions --- test/lite/oracle.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index a0b0612..c575692 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -72,4 +72,6 @@ let parse_lite_adapted ?depth_limit let parse ?depth_limit ?(context : [ `Document | `Fragment of string ] = `Document) report html = - html |> adapt |> parse_adapted ?depth_limit ~context report + Markup.string html + |> Markup.parse_html ~report ~context ?depth_limit + |> Markup.signals From 7a1a4d7a5ed46d6a9a321b2049cffe2d35d53668 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:52:32 -0400 Subject: [PATCH 077/109] Separate native and explicit text run semantics --- src/lite/html_parser.ml | 3 ++- src/lite/token_source.ml | 5 +++++ src/lite/token_source.mli | 1 + 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index 2112902..dff7a4e 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -2170,7 +2170,8 @@ let parse ?depth_limit requested_context report tokens = List.rev cs |> List.iter (function | l, Char c -> add_character l c - | l, String s -> add_string l s + | l, String s when Token_source.native_text_runs tokens -> + add_string l s | _ -> ()); mode () end diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index 01e24a1..b545155 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -12,6 +12,7 @@ type t = { scanner : Ragel_html_tokenizer.t; mutable pushed : pushed_token list; mutable foreign : unit -> bool; + native_text_runs : bool; } let valid_utf_8 = String.is_valid_utf_8 @@ -67,6 +68,7 @@ let create html = scanner = Ragel_html_tokenizer.create html; pushed = []; foreign = (fun () -> false); + native_text_runs = true; } let of_tokens tokens = @@ -77,8 +79,11 @@ let of_tokens tokens = scanner = Ragel_html_tokenizer.create ""; pushed; foreign = (fun () -> false); + native_text_runs = false; } +let native_text_runs source = source.native_text_runs + let location () = { line = 1; column = -1 } let next source state ~drop_candidate (out : location_out) = diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli index a3f0b82..fdaa48d 100644 --- a/src/lite/token_source.mli +++ b/src/lite/token_source.mli @@ -8,6 +8,7 @@ type t val create : string -> t val of_tokens : (location * Html_tokenizer.token) list -> t +val native_text_runs : t -> bool val location : unit -> location_out val next : From b2bffb657fd9e124137078bbf9c9fbf387b39cd4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:52:32 -0400 Subject: [PATCH 078/109] Improve strict parser mismatch diagnostics --- test/lite/lite_parser_diff_corpus.ml | 39 +++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/test/lite/lite_parser_diff_corpus.ml b/test/lite/lite_parser_diff_corpus.ml index a2db8c4..340599e 100644 --- a/test/lite/lite_parser_diff_corpus.ml +++ b/test/lite/lite_parser_diff_corpus.ml @@ -46,12 +46,45 @@ let run parse collect_signals = (with_timeout (fun () -> collect_signals (parse report)), List.rev !errors) with exn -> Raised (Printexc.to_string exn, List.rev !errors) +let first_difference to_string left right = + let rec loop index left right = + match (left, right) with + | [], [] -> "no difference" + | [], _ :: _ -> Printf.sprintf "baseline ended at %d" index + | _ :: _, [] -> Printf.sprintf "Lite ended at %d" index + | x :: xs, y :: ys -> + if x = y then loop (index + 1) xs ys + else + Printf.sprintf "item %d: baseline=%s Lite=%s" index (to_string x) + (to_string y) + in + loop 0 left right + +let error_to_string ((line, column), error) = + Printf.sprintf "(%d,%d) %s" line column (Markup_common.Error.to_string error) + let compare name baseline lite = - if baseline <> lite then begin - Printf.eprintf "%s: strict parser mismatch\n" name; + if baseline = lite then true + else begin + begin match (baseline, lite) with + | Parsed (signals, errors), Parsed (lite_signals, lite_errors) -> + if signals <> lite_signals then + Printf.eprintf "%s: signal mismatch: %s\n" name + (first_difference Markup_common.signal_to_string signals + lite_signals) + else + Printf.eprintf "%s: error mismatch: %s\n" name + (first_difference error_to_string errors lite_errors) + | Raised (exn, _), Raised (lite_exn, _) -> + Printf.eprintf "%s: exception mismatch: baseline=%S Lite=%S\n" name exn + lite_exn + | Raised (exn, _), Parsed _ -> + Printf.eprintf "%s: baseline raised %S but Lite parsed\n" name exn + | Parsed _, Raised (exn, _) -> + Printf.eprintf "%s: Lite raised %S but baseline parsed\n" name exn + end; false end - else true let contexts = [ From e9c51df3ca91440d9686e5b26f637c1e6ac668b8 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:55:26 -0400 Subject: [PATCH 079/109] Report CPU throughput and collections in benchmarks --- test/lite/lite_count_corpus.ml | 57 ++++++++++++++++++++++++++++------ 1 file changed, 47 insertions(+), 10 deletions(-) diff --git a/test/lite/lite_count_corpus.ml b/test/lite/lite_count_corpus.ml index 7d263ba..d6d2405 100644 --- a/test/lite/lite_count_corpus.ml +++ b/test/lite/lite_count_corpus.ml @@ -43,27 +43,56 @@ let html_files directory = type stats = { mutable wall_seconds : float; + mutable user_seconds : float; + mutable system_seconds : float; mutable minor_words : float; mutable major_words : float; mutable promoted_words : float; + mutable minor_collections : int; + mutable major_collections : int; + mutable compactions : int; } let empty_stats () = - { wall_seconds = 0.; minor_words = 0.; major_words = 0.; promoted_words = 0. } + { + wall_seconds = 0.; + user_seconds = 0.; + system_seconds = 0.; + minor_words = 0.; + major_words = 0.; + promoted_words = 0.; + minor_collections = 0; + major_collections = 0; + compactions = 0; + } let measure stats f = let gc_before = Gc.quick_stat () in + let cpu_before = Unix.times () in let wall_before = Unix.gettimeofday () in let result = f () in let wall_after = Unix.gettimeofday () in + let cpu_after = Unix.times () in let gc_after = Gc.quick_stat () in stats.wall_seconds <- stats.wall_seconds +. wall_after -. wall_before; + stats.user_seconds <- + stats.user_seconds +. cpu_after.tms_utime -. cpu_before.tms_utime; + stats.system_seconds <- + stats.system_seconds +. cpu_after.tms_stime -. cpu_before.tms_stime; stats.minor_words <- stats.minor_words +. gc_after.minor_words -. gc_before.minor_words; stats.major_words <- stats.major_words +. gc_after.major_words -. gc_before.major_words; stats.promoted_words <- stats.promoted_words +. gc_after.promoted_words -. gc_before.promoted_words; + stats.minor_collections <- + stats.minor_collections + gc_after.minor_collections + - gc_before.minor_collections; + stats.major_collections <- + stats.major_collections + gc_after.major_collections + - gc_before.major_collections; + stats.compactions <- + stats.compactions + gc_after.compactions - gc_before.compactions; result type outcome = Count of int | Raised of string @@ -76,10 +105,12 @@ let count iter stream = let run f = try Count (f ()) with exn -> Raised (Printexc.to_string exn) let count_oracle html = - run (fun () -> Oracle.parse (fun _ _ -> ()) html |> count Markup.iter) + run (fun () -> + Oracle.parse ~context:`Document (fun _ _ -> ()) html |> count Markup.iter) let count_lite html = - run (fun () -> Markup_lite.parse_html html |> count Markup_lite.iter) + run (fun () -> + Markup_lite.parse_html ~context:`Document html |> count Markup_lite.iter) let compare path oracle lite = match (oracle, lite) with @@ -102,11 +133,17 @@ let compare path oracle lite = count exception_; None -let print_stats name stats = +let print_stats name bytes stats = + let mib = float bytes /. 1048576. in Printf.printf - "%s: wall_seconds=%.6f minor_words=%.0f major_words=%.0f promoted_words=%.0f\n" - name stats.wall_seconds stats.minor_words stats.major_words - stats.promoted_words + "%s: wall_seconds=%.6f user_seconds=%.6f system_seconds=%.6f \ + throughput_mib_s=%.2f minor_words=%.0f major_words=%.0f \ + promoted_words=%.0f minor_collections=%d major_collections=%d \ + compactions=%d\n" + name stats.wall_seconds stats.user_seconds stats.system_seconds + (mib /. stats.wall_seconds) + stats.minor_words stats.major_words stats.promoted_words + stats.minor_collections stats.major_collections stats.compactions let run_one name count_parser files = let stats = empty_stats () in @@ -127,7 +164,7 @@ let run_one name count_parser files = Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files); Printf.printf "files=%d bytes=%d signals=%d exceptions=%d\n" (List.length files) !bytes !signals !exceptions; - print_stats (name ^ " count") stats; + print_stats (name ^ " count") !bytes stats; Printf.printf "OK: %d HTML files consumed with %s\n%!" (List.length files) name @@ -163,8 +200,8 @@ let run_both files = Printf.eprintf "checked %d/%d\n%!" (List.length files) (List.length files); Printf.printf "files=%d bytes=%d signals=%d\n" (List.length files) !bytes !signals; - print_stats "oracle count" oracle_stats; - print_stats "lite count" lite_stats; + print_stats "oracle count" !bytes oracle_stats; + print_stats "lite count" !bytes lite_stats; if !failures <> 0 then begin Printf.eprintf "FAILED: %d files differed\n" !failures; exit 1 From 703613598c078cfc2c3ea1415b4187c008a80ebc Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:55:58 -0400 Subject: [PATCH 080/109] Add parser-only adapted token benchmark --- test/lite/dune | 5 ++ test/lite/lite_parser_count_corpus.ml | 113 ++++++++++++++++++++++++++ 2 files changed, 118 insertions(+) create mode 100644 test/lite/lite_parser_count_corpus.ml diff --git a/test/lite/dune b/test/lite/dune index 8432b6a..02acba5 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -14,6 +14,11 @@ (modules lite_parser_diff_corpus) (libraries containers lite_test_oracle markup markup.lite unix)) +(executable + (name lite_parser_count_corpus) + (modules lite_parser_count_corpus) + (libraries containers lite_test_oracle markup markup.lite unix)) + (executable (name lite_count_corpus) (modules lite_count_corpus) diff --git a/test/lite/lite_parser_count_corpus.ml b/test/lite/lite_parser_count_corpus.ml new file mode 100644 index 0000000..7ecb9b4 --- /dev/null +++ b/test/lite/lite_parser_count_corpus.ml @@ -0,0 +1,113 @@ +let usage program = + Printf.eprintf "Usage: %s DIRECTORY\n" program; + exit 2 + +let html_files directory = + let files = CCIO.File.read_dir ~recurse:true (CCIO.File.make directory) in + let rec collect acc = + match files () with + | None -> List.sort String.compare acc + | Some path -> + let path = CCIO.File.to_string path in + collect + (if Filename.check_suffix path ".html" then path :: acc else acc) + in + collect [] + +let count iter stream = + let count = ref 0 in + iter (fun _ -> incr count) stream; + !count + +type stats = { + mutable wall : float; + mutable user : float; + mutable system : float; + mutable words : float; + mutable minor_collections : int; + mutable major_collections : int; +} + +let stats () = + { + wall = 0.; + user = 0.; + system = 0.; + words = 0.; + minor_collections = 0; + major_collections = 0; + } + +let measure stats f = + let gc_before = Gc.quick_stat () in + let cpu_before = Unix.times () in + let wall_before = Unix.gettimeofday () in + let result = f () in + let wall_after = Unix.gettimeofday () in + let cpu_after = Unix.times () in + let gc_after = Gc.quick_stat () in + stats.wall <- stats.wall +. wall_after -. wall_before; + stats.user <- stats.user +. cpu_after.tms_utime -. cpu_before.tms_utime; + stats.system <- stats.system +. cpu_after.tms_stime -. cpu_before.tms_stime; + stats.words <- + stats.words +. gc_after.minor_words +. gc_after.major_words + -. gc_before.minor_words -. gc_before.major_words; + stats.minor_collections <- + stats.minor_collections + gc_after.minor_collections + - gc_before.minor_collections; + stats.major_collections <- + stats.major_collections + gc_after.major_collections + - gc_before.major_collections; + result + +let print name bytes stats = + Printf.printf + "%s: wall_seconds=%.6f user_seconds=%.6f system_seconds=%.6f \ + throughput_mib_s=%.2f allocated_words=%.0f minor_collections=%d \ + major_collections=%d\n" + name stats.wall stats.user stats.system + (float bytes /. 1048576. /. stats.wall) + stats.words stats.minor_collections stats.major_collections + +let () = + let directory = + match Array.to_list Sys.argv with + | [ _; directory ] -> directory + | _ -> usage Sys.argv.(0) + in + let files = html_files directory in + if files = [] then usage Sys.argv.(0); + let baseline_stats = stats () in + let lite_stats = stats () in + let bytes = ref 0 in + let failures = ref 0 in + List.iteri + (fun index path -> + let html = CCIO.File.read_exn (CCIO.File.make path) in + bytes := !bytes + String.length html; + (* HtmlStream production and adaptation are outside both timed regions. *) + let tokens = Oracle.adapt html in + let baseline () = + Oracle.parse_adapted ~context:`Document (fun _ _ -> ()) tokens + |> count Markup.iter + in + let lite () = + Oracle.parse_lite_adapted ~context:`Document (fun _ _ -> ()) tokens + |> count Markup_lite.iter + in + let baseline_count, lite_count = + if index mod 2 = 0 then + (measure baseline_stats baseline, measure lite_stats lite) + else + let lite_count = measure lite_stats lite in + (measure baseline_stats baseline, lite_count) + in + if baseline_count <> lite_count then begin + incr failures; + Printf.eprintf "%s: signal count differs: %d vs %d\n" path + baseline_count lite_count + end) + files; + print "baseline parser-only" !bytes baseline_stats; + print "Lite parser-only" !bytes lite_stats; + if !failures <> 0 then exit 1 From 2da6a349ba795a5b28f8e30a741a34c4421634fb Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:56:50 -0400 Subject: [PATCH 081/109] Measure residual allocations in corpus benchmarks --- test/lite/lite_count_corpus.ml | 18 +++++++++++++----- test/lite/lite_parser_count_corpus.ml | 6 ++++-- 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/test/lite/lite_count_corpus.ml b/test/lite/lite_count_corpus.ml index d6d2405..c65ca40 100644 --- a/test/lite/lite_count_corpus.ml +++ b/test/lite/lite_count_corpus.ml @@ -48,6 +48,7 @@ type stats = { mutable minor_words : float; mutable major_words : float; mutable promoted_words : float; + mutable allocated_words : float; mutable minor_collections : int; mutable major_collections : int; mutable compactions : int; @@ -61,6 +62,7 @@ let empty_stats () = minor_words = 0.; major_words = 0.; promoted_words = 0.; + allocated_words = 0.; minor_collections = 0; major_collections = 0; compactions = 0; @@ -68,12 +70,14 @@ let empty_stats () = let measure stats f = let gc_before = Gc.quick_stat () in + let allocated_before = Gc.allocated_bytes () in let cpu_before = Unix.times () in let wall_before = Unix.gettimeofday () in let result = f () in let wall_after = Unix.gettimeofday () in let cpu_after = Unix.times () in let gc_after = Gc.quick_stat () in + let allocated_after = Gc.allocated_bytes () in stats.wall_seconds <- stats.wall_seconds +. wall_after -. wall_before; stats.user_seconds <- stats.user_seconds +. cpu_after.tms_utime -. cpu_before.tms_utime; @@ -85,6 +89,9 @@ let measure stats f = stats.major_words +. gc_after.major_words -. gc_before.major_words; stats.promoted_words <- stats.promoted_words +. gc_after.promoted_words -. gc_before.promoted_words; + stats.allocated_words <- + stats.allocated_words + +. ((allocated_after -. allocated_before) /. (float Sys.word_size /. 8.)); stats.minor_collections <- stats.minor_collections + gc_after.minor_collections - gc_before.minor_collections; @@ -137,13 +144,14 @@ let print_stats name bytes stats = let mib = float bytes /. 1048576. in Printf.printf "%s: wall_seconds=%.6f user_seconds=%.6f system_seconds=%.6f \ - throughput_mib_s=%.2f minor_words=%.0f major_words=%.0f \ - promoted_words=%.0f minor_collections=%d major_collections=%d \ - compactions=%d\n" + throughput_mib_s=%.2f allocated_words=%.0f minor_words=%.0f \ + major_words=%.0f promoted_words=%.0f minor_collections=%d \ + major_collections=%d compactions=%d\n" name stats.wall_seconds stats.user_seconds stats.system_seconds (mib /. stats.wall_seconds) - stats.minor_words stats.major_words stats.promoted_words - stats.minor_collections stats.major_collections stats.compactions + stats.allocated_words stats.minor_words stats.major_words + stats.promoted_words stats.minor_collections stats.major_collections + stats.compactions let run_one name count_parser files = let stats = empty_stats () in diff --git a/test/lite/lite_parser_count_corpus.ml b/test/lite/lite_parser_count_corpus.ml index 7ecb9b4..9421b83 100644 --- a/test/lite/lite_parser_count_corpus.ml +++ b/test/lite/lite_parser_count_corpus.ml @@ -40,18 +40,20 @@ let stats () = let measure stats f = let gc_before = Gc.quick_stat () in + let allocated_before = Gc.allocated_bytes () in let cpu_before = Unix.times () in let wall_before = Unix.gettimeofday () in let result = f () in let wall_after = Unix.gettimeofday () in let cpu_after = Unix.times () in let gc_after = Gc.quick_stat () in + let allocated_after = Gc.allocated_bytes () in stats.wall <- stats.wall +. wall_after -. wall_before; stats.user <- stats.user +. cpu_after.tms_utime -. cpu_before.tms_utime; stats.system <- stats.system +. cpu_after.tms_stime -. cpu_before.tms_stime; stats.words <- - stats.words +. gc_after.minor_words +. gc_after.major_words - -. gc_before.minor_words -. gc_before.major_words; + stats.words + +. ((allocated_after -. allocated_before) /. (float Sys.word_size /. 8.)); stats.minor_collections <- stats.minor_collections + gc_after.minor_collections - gc_before.minor_collections; From 9f5f2e5dcb43b8c0e294e39a05fe7dba4b5b90e7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 22:57:51 -0400 Subject: [PATCH 082/109] Format Lite tokenizer support --- src/lite/markup_declaration.ml | 18 +++++++++++++++--- src/lite/token_source.ml | 1 - 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/src/lite/markup_declaration.ml b/src/lite/markup_declaration.ml index b5fc043..c55d9a3 100644 --- a/src/lite/markup_declaration.ml +++ b/src/lite/markup_declaration.ml @@ -51,7 +51,11 @@ let bogus_comment data start = let buffer = Buffer.create 32 in let rec consume index = if index >= length then - { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index; lowercase = 0 } + { + token = Html_tokenizer.Comment (Buffer.contents buffer); + next = index; + lowercase = 0; + } else match data.[index] with | '>' -> @@ -70,7 +74,11 @@ let comment data start = let length = String.length data in let buffer = Buffer.create 64 in let finish index = - { token = Html_tokenizer.Comment (Buffer.contents buffer); next = index; lowercase = 0 } + { + token = Html_tokenizer.Comment (Buffer.contents buffer); + next = index; + lowercase = 0; + } in let rec comment_start index = if index >= length then finish index @@ -360,7 +368,11 @@ let cdata data start = let length = String.length data in let buffer = Buffer.create 64 in let finish next = - { token = Html_tokenizer.String (Buffer.contents buffer); next; lowercase = 0 } + { + token = Html_tokenizer.String (Buffer.contents buffer); + next; + lowercase = 0; + } in let rec consume index = if index >= length then finish index diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index b545155..fb5e4aa 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -83,7 +83,6 @@ let of_tokens tokens = } let native_text_runs source = source.native_text_runs - let location () = { line = 1; column = -1 } let next source state ~drop_candidate (out : location_out) = From 2443b3139538d73ef9527f415809868f45dabe33 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 23:26:35 -0400 Subject: [PATCH 083/109] Honor declared legacy HTML encodings --- src/lite/dune | 2 +- src/lite/encoding.ml | 187 ++++++++++++++++++++++++++ src/lite/token_source.ml | 1 + test/lite/lite_baseline_regression.ml | 11 ++ 4 files changed, 200 insertions(+), 1 deletion(-) create mode 100644 src/lite/encoding.ml diff --git a/src/lite/dune b/src/lite/dune index 3a01f54..21758cb 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -7,7 +7,7 @@ (name markup_lite) (public_name markup.lite) (synopsis "Small fast synchronous HTML parser") - (private_modules common error html_entity_decoder html_parser html_tokenizer + (private_modules common encoding error html_entity_decoder html_parser html_tokenizer html_writer kstream markup_declaration namespace ragel_html_tokenizer raw_text text token_source) (libraries markup.common markup.entities uutf) diff --git a/src/lite/encoding.ml b/src/lite/encoding.ml new file mode 100644 index 0000000..c0f4bc6 --- /dev/null +++ b/src/lite/encoding.ml @@ -0,0 +1,187 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +let ascii_lower = Char.lowercase_ascii +let is_space = function ' ' | '\t' | '\n' | '\r' | '\x0C' -> true | _ -> false + +let declared_encoding input = + let length = min 1024 (String.length input) in + let needle = "charset" in + let rec matches index offset = + offset = String.length needle + || index + offset < length + && ascii_lower input.[index + offset] = needle.[offset] + && matches index (offset + 1) + in + let rec skip_spaces index = + if index < length && is_space input.[index] then skip_spaces (index + 1) + else index + in + let rec value_end index = + if index < length then + match input.[index] with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' -> value_end (index + 1) + | _ -> index + else index + in + let rec search index = + if index + String.length needle > length then None + else if not (matches index 0) then search (index + 1) + else + let after_name = skip_spaces (index + String.length needle) in + if after_name >= length || input.[after_name] <> '=' then + search (index + 1) + else + let start = skip_spaces (after_name + 1) in + let start = + if start < length && (input.[start] = '\'' || input.[start] = '"') + then start + 1 + else start + in + let stop = value_end start in + if stop = start then search (index + 1) + else + Some (String.sub input start (stop - start) |> String.lowercase_ascii) + in + search 0 + +let windows_1252_high = + [| + 0x20AC; + 0x0081; + 0x201A; + 0x0192; + 0x201E; + 0x2026; + 0x2020; + 0x2021; + 0x02C6; + 0x2030; + 0x0160; + 0x2039; + 0x0152; + 0x008D; + 0x017D; + 0x008F; + 0x0090; + 0x2018; + 0x2019; + 0x201C; + 0x201D; + 0x2022; + 0x2013; + 0x2014; + 0x02DC; + 0x2122; + 0x0161; + 0x203A; + 0x0153; + 0x009D; + 0x017E; + 0x0178; + |] + +let windows_1251_high = + [| + 0x0402; + 0x0403; + 0x201A; + 0x0453; + 0x201E; + 0x2026; + 0x2020; + 0x2021; + 0x20AC; + 0x2030; + 0x0409; + 0x2039; + 0x040A; + 0x040C; + 0x040B; + 0x040F; + 0x0452; + 0x2018; + 0x2019; + 0x201C; + 0x201D; + 0x2022; + 0x2013; + 0x2014; + 0xFFFD; + 0x2122; + 0x0459; + 0x203A; + 0x045A; + 0x045C; + 0x045B; + 0x045F; + 0x00A0; + 0x040E; + 0x045E; + 0x0408; + 0x00A4; + 0x0490; + 0x00A6; + 0x00A7; + 0x0401; + 0x00A9; + 0x0404; + 0x00AB; + 0x00AC; + 0x00AD; + 0x00AE; + 0x0407; + 0x00B0; + 0x00B1; + 0x0406; + 0x0456; + 0x0491; + 0x00B5; + 0x00B6; + 0x00B7; + 0x0451; + 0x2116; + 0x0454; + 0x00BB; + 0x0458; + 0x0405; + 0x0455; + 0x0457; + |] + +let transcode scalar input = + let output = Buffer.create (String.length input + 32) in + String.iter + (fun byte -> + Uutf.Buffer.add_utf_8 output (Uchar.of_int (scalar (Char.code byte)))) + input; + Buffer.contents output + +let windows_1252 input = + transcode + (fun byte -> + if byte < 0x80 || byte >= 0xA0 then byte + else windows_1252_high.(byte - 0x80)) + input + +let windows_1251 input = + transcode + (fun byte -> + if byte < 0x80 then byte + else if byte < 0xC0 then windows_1251_high.(byte - 0x80) + (* Match the baseline's long-standing Windows-1251 table exactly. *) + else if byte = 0xD0 then 0x0410 + else 0x0410 + byte - 0xC0) + input + +let decode_html input = + if String.length input >= 3 && String.sub input 0 3 = "\xEF\xBB\xBF" then + input + else + match declared_encoding input with + | Some ("windows-1251" | "cp1251" | "x-cp1251") -> windows_1251 input + | Some + ( "windows-1252" | "cp1252" | "x-cp1252" | "iso-8859-1" | "latin1" + | "us-ascii" | "ascii" ) -> + windows_1252 input + | _ -> input diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index fb5e4aa..b73646d 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -61,6 +61,7 @@ let strip_leading_bom html = if start = 0 then html else String.sub html start (length - start) let create html = + let html = Encoding.decode_html html in let html = if valid_utf_8 html then html else replace_malformed html in let html = strip_leading_bom html in let html = normalize_newlines html in diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 0768121..348156e 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -95,6 +95,17 @@ let () = agrees "byte in text" "<p>a\xffb</p>"; agrees "continuation bytes" "\xb5\x95"; ]; + "declared encoding" + >::: [ + agrees "windows-1251" + "<meta charset=windows-1251><p>\xCF\xF0\xE8\xE2\xE5\xF2"; + agrees "baseline windows-1251 D0 mapping" + "<meta charset=windows-1251><p>\xD0"; + agrees "HTML iso-8859-1 is windows-1252" + "<meta charset=iso-8859-1><p>caf\xE9"; + agrees "UTF-8 BOM takes precedence" + "\xEF\xBB\xBF<meta charset=windows-1251><p>caf\xC3\xA9"; + ]; "crlf" >::: [ agrees "crlf in text" "<p>a\r\nb</p>"; agrees "lone cr" "a\rb"; From f35dc118a38bf0ab1e7ed72bd075cad737dde9f0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 14:13:23 +0000 Subject: [PATCH 084/109] fix is_whitespace_only in baseline html parser for the String token path it was inconsistent with the rest of the module --- src/baseline/html_parser.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/baseline/html_parser.ml b/src/baseline/html_parser.ml index b7b3bbf..19c906b 100644 --- a/src/baseline/html_parser.ml +++ b/src/baseline/html_parser.ml @@ -5,7 +5,9 @@ open Common open Token_tag open Kstream - +(* HTML space characters include U+000C, unlike XML whitespace. *) +let is_whitespace_only s = + String.for_all (fun c -> c = '\x0c' || is_whitespace (int_of_char c)) s (* Namespaces for pattern matching. *) type ns = [ `HTML | `MathML | `SVG | `Other of string ] From 9ceab7d48e887fd060bd9b146717be062606e45a Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 14:13:28 +0000 Subject: [PATCH 085/109] format --- src/lite/dune | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lite/dune b/src/lite/dune index 21758cb..a8d505e 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -7,9 +7,9 @@ (name markup_lite) (public_name markup.lite) (synopsis "Small fast synchronous HTML parser") - (private_modules common encoding error html_entity_decoder html_parser html_tokenizer - html_writer kstream markup_declaration namespace ragel_html_tokenizer - raw_text text token_source) + (private_modules common encoding error html_entity_decoder html_parser + html_tokenizer html_writer kstream markup_declaration namespace + ragel_html_tokenizer raw_text text token_source) (libraries markup.common markup.entities uutf) (flags (:standard -w -9))) From 08025670f190caa62633c1716ff717266e709aa1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 14:14:21 +0000 Subject: [PATCH 086/109] fuzz oracle: sanitize `\x00` in tokenizer --- test/lite/lite_dump_signals.ml | 7 +++++-- test/lite/oracle.ml | 24 ++++++++++++++++++++---- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/test/lite/lite_dump_signals.ml b/test/lite/lite_dump_signals.ml index 4a648d0..cb8bf86 100644 --- a/test/lite/lite_dump_signals.ml +++ b/test/lite/lite_dump_signals.ml @@ -51,6 +51,9 @@ let read_all channel = let () = let input = read_all stdin in let context, input = context_of_input input in - Printf.printf "input: %S\n" input; + Printf.printf "input: %S\n%!" input; + Printf.eprintf "oracle...\n%!"; print "oracle" (oracle context input); - print "lite" (lite context input) + Printf.eprintf "lite...\n%!"; + print "lite" (lite context input); + Printf.eprintf "done\n%!" diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index c575692..7eee8f0 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -1,5 +1,11 @@ module HS = Devkit.HtmlStream +(* Raw-text tokenizer states substitute U+FFFD for U+0000. *) +let raw_text text = + if String.contains text '\x00' then + String.concat "\xEF\xBF\xBD" (String.split_on_char '\x00' text) + else text + let decode raw = let inner = HS.Raw.project raw in try Devkit.Web.htmldecode inner with _ -> inner @@ -13,23 +19,33 @@ let adapt html : (Markup.location * Markup.Internals.token) list = let tokens = ref [] in let emit token = tokens := ((HS.get_lnum ctx, -1), token) :: !tokens in let attributes attrs = - List.rev_map (fun (name, value) -> (name, decode value)) attrs + List.rev_map + (fun (name, value) -> (raw_text name, raw_text (decode value))) + attrs in let tag name attributes : Markup.Internals.Token_tag.t = { name; attributes; self_closing = false } in + (* Both tree builders assume tokenizers never leave U+0000 inside a + [`String]; split NULs out as [`Char 0] to preserve that invariant. *) + let emit_text text = + String.split_on_char '\x00' text + |> List.iteri (fun i part -> + if i > 0 then emit (`Char 0); + if part <> "" then emit (`String part)) + in let step = function - | HS.Text raw -> emit (`String (decode raw)) + | HS.Text raw -> emit_text (decode raw) | HS.Tag (name, attrs) -> emit (`Start (tag name (attributes attrs))) | HS.Close "br" -> () | HS.Close name -> emit (`End (tag name [])) | HS.Script (attrs, text) -> emit (`Start (tag "script" (attributes attrs))); - emit (`String text); + emit (`String (raw_text text)); emit (`End (tag "script" [])) | HS.Style (attrs, text) -> emit (`Start (tag "style" (attributes attrs))); - emit (`String text); + emit (`String (raw_text text)); emit (`End (tag "style" [])) in HS.parse ~ctx step html; From c75791a1795139eae6455a141b725b64b969e21c Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Thu, 27 Aug 2026 23:56:32 -0400 Subject: [PATCH 087/109] Run strict parser corpus checks in test-lite --- Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Makefile b/Makefile index 4e172fd..12936c1 100644 --- a/Makefile +++ b/Makefile @@ -26,6 +26,7 @@ test : LITE_TEST_EXE := _build/default/test/lite/lite_diff_corpus.exe LITE_COUNT_TEST_EXE := _build/default/test/lite/lite_count_corpus.exe +LITE_PARSER_TEST_EXE := _build/default/test/lite/lite_parser_diff_corpus.exe LITE_WRITER_TEST_EXE := _build/default/test/lite/lite_writer_diff_corpus.exe LITE_TEST_CORPUS ?= big_tests @@ -33,9 +34,11 @@ LITE_TEST_CORPUS ?= big_tests test-lite : dune build --profile release test/lite/lite_diff_corpus.exe \ test/lite/lite_count_corpus.exe \ + test/lite/lite_parser_diff_corpus.exe \ test/lite/lite_writer_diff_corpus.exe $(LITE_TEST_EXE) $(LITE_TEST_CORPUS) $(LITE_COUNT_TEST_EXE) $(LITE_TEST_CORPUS) + $(LITE_PARSER_TEST_EXE) $(LITE_TEST_CORPUS) $(LITE_WRITER_TEST_EXE) $(LITE_TEST_CORPUS) LITE_AFL_EXE := _build-afl/default/test/fuzz/lite_diff_fuzz.exe From 473be3d02e81f8df2977fd7fdc6104f9a77b8864 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 00:05:33 -0400 Subject: [PATCH 088/109] Fix foreign reentry and row recovery --- src/lite/html_parser.ml | 9 +++++++++ test/lite/lite_baseline_regression.ml | 20 ++++++-------------- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index dff7a4e..178e1e4 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -2380,6 +2380,7 @@ let parse ?depth_limit requested_context report tokens = close_cell l (fun () -> Active.clear_until_marker active_formatting_elements; push tokens v; + current_mode := in_row_mode; in_row_mode ()) | ( l, End @@ -2398,6 +2399,7 @@ let parse ?depth_limit requested_context report tokens = close_cell l (fun () -> Active.clear_until_marker active_formatting_elements; push tokens v; + current_mode := in_row_mode; in_row_mode ()) | l, Start ({ name = "select" } as t) -> select_in_body l t in_select_in_table_mode @@ -2682,6 +2684,13 @@ let parse ?depth_limit requested_context report tokens = (fun () -> add_character l u_rep; mode ()) + | l, String s when s <> "" && Subtree.buffering subtree_buffer -> + let decoded = String.get_utf_8_uchar s 0 in + let width = Uchar.utf_decode_length decoded in + if width < String.length s then + push tokens (l, String (String.sub s width (String.length s - width))); + foreign_content mode force_html + (l, Char (Uchar.to_int (Uchar.utf_decode_uchar decoded))) | l, String s -> add_string l (replace_nulls s); if not @@ is_whitespace_only (remove_nulls s) then frameset_ok := false; diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 348156e..32d09d5 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -40,17 +40,9 @@ let agrees_with_text ?(context = `Document) name html text = | `Text strings -> String.concat "" strings = text | _ -> false) actual) -let disagrees ?(context = `Document) name html = - name >:: fun _ -> - assert_bool "baseline and lite now agree; promote this test to [agrees]" - (baseline context html <> lite context html) - -(* FIXME *) -(* this input makes the parser loop forever (misnested math/tr in row mode) *) let terminates = "in row misnested math" >:: fun _ -> - if false then - ignore (lite `Document "<table><tr><math></tr><td><tr><b><math>0") + ignore (lite `Document "<table><tr><math></tr><td><tr><b><math>0") let () = run_test_tt_main @@ -196,11 +188,11 @@ let () = (fun (location, _) -> location = (7, 11)) !reports) ); ]; - "known divergence: foreign breakout reentry" + "foreign breakout reentry" >::: [ - disagrees "svg b svg text" "<svg><b><svg>ab"; - disagrees "math b math text" "<math><b><math>xy"; - disagrees "svg s svg digits" "<svg><s><svg>00"; + agrees "svg b svg text" "<svg><b><svg>ab"; + agrees "math b math text" "<math><b><math>xy"; + agrees "svg s svg digits" "<svg><s><svg>00"; ]; "cdata in foreign content" >::: [ @@ -230,5 +222,5 @@ let () = agrees ~context:(`Fragment "svg") "complete candidate" "<p></p><style></x>"; ]; - "known non-termination" >::: [ terminates ]; + "termination" >::: [ terminates ]; ]) From 226daf0d72d4e32a564b15278d73fd74a88f7202 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 00:05:57 -0400 Subject: [PATCH 089/109] Document the HtmlStream adapter policy --- test/lite/htmlstream-adapter.md | 34 +++++++++++++++++++++++++++++++++ test/lite/oracle.ml | 10 ++++++---- 2 files changed, 40 insertions(+), 4 deletions(-) create mode 100644 test/lite/htmlstream-adapter.md diff --git a/test/lite/htmlstream-adapter.md b/test/lite/htmlstream-adapter.md new file mode 100644 index 0000000..67efe0c --- /dev/null +++ b/test/lite/htmlstream-adapter.md @@ -0,0 +1,34 @@ +# HtmlStream parser adapter + +`Oracle.adapt` in `oracle.ml` is a test-only adapter. It parses each byte string +once with `Devkit.HtmlStream` and produces one token list. The strict corpus +comparison and strict AFL harness derive both the baseline and Lite parser +inputs from that list. + +## Common policy + +The adapter applies the same omissions and defaults to both parsers: + +- locations are `(HtmlStream line, -1)`, because HtmlStream does not expose a + useful common column; +- start tags default `self_closing` to `false`; +- comments are omitted because HtmlStream does not expose them; +- `Script` and `Style` values become a start tag, one `String` token, and an end + tag; +- other text remains in `String` runs; +- attributes are kept in HtmlStream's source order and their values are decoded + once; +- HtmlStream's synthetic `Close "br"` after a `br` tag is omitted; +- one explicit `EOF` token is appended. + +HtmlStream has no fragment tokenizer mode. Fragment context is therefore +applied only when the common token list is passed to each parser. Depth limits +are likewise parser settings and do not affect adaptation. + +## Suitability + +This adapter is suitable for differential parser testing because both parsers +receive the same token values and the same missing information. It is not a +production tokenizer adapter: it loses comments, self-closing syntax, columns, +raw-text boundary details, tokenizer reports, and tree-builder feedback. Devkit +therefore remains a test/fuzz dependency and is not linked into `markup.lite`. diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index 7eee8f0..109fe46 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -10,10 +10,12 @@ let decode raw = let inner = HS.Raw.project raw in try Devkit.Web.htmldecode inner with _ -> inner -(* HtmlStream does not expose comments, self-closing syntax, raw-text token - boundaries, or columns. The strict parser oracle therefore omits comments, - defaults [self_closing] to false, expands Script/Style into three tokens, - and uses [(line, -1)] for both parsers. *) +(* See [htmlstream-adapter.md] for the common adaptation policy and its + test-only suitability assessment. HtmlStream does not expose comments, + self-closing syntax, raw-text token boundaries, or columns. The strict + parser oracle therefore omits comments, defaults [self_closing] to false, + expands Script/Style into three tokens, and uses [(line, -1)] for both + parsers. *) let adapt html : (Markup.location * Markup.Internals.token) list = let ctx = HS.init () in let tokens = ref [] in From b6a0548eb20e014ea96d8aac6588cfb39591110c Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 10:06:29 -0400 Subject: [PATCH 090/109] Fast-path native data text scanning in tokenizer use C bindings to find next `<`, also to count `\n` (for locations). --- src/lite/dune | 5 ++++- src/lite/ragel_html_tokenizer.ml | 19 ++++++++++++++++++ src/lite/ragel_html_tokenizer.ml.rl | 21 +++++++++++++++++++ src/lite/string_helpers.c | 31 +++++++++++++++++++++++++++++ src/lite/string_helpers.ml | 20 +++++++++++++++++++ 5 files changed, 95 insertions(+), 1 deletion(-) create mode 100644 src/lite/string_helpers.c create mode 100644 src/lite/string_helpers.ml diff --git a/src/lite/dune b/src/lite/dune index a8d505e..b6500d5 100644 --- a/src/lite/dune +++ b/src/lite/dune @@ -9,7 +9,10 @@ (synopsis "Small fast synchronous HTML parser") (private_modules common encoding error html_entity_decoder html_parser html_tokenizer html_writer kstream markup_declaration namespace - ragel_html_tokenizer raw_text text token_source) + ragel_html_tokenizer raw_text string_helpers text token_source) (libraries markup.common markup.entities uutf) + (foreign_stubs + (language c) + (names string_helpers)) (flags (:standard -w -9))) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 5ef126b..4d63cae 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -602,6 +602,24 @@ let create data = finished = false; } +let scan_data_text scanner = + let start = !(scanner.p) in + let limit = !(scanner.eof) in + if + !(scanner.cs) <> htmlstream_en_main + || !(scanner.mark) >= 0 || start >= limit + || scanner.data.[start] = '<' + then false + else begin + let stop = String_helpers.find scanner.data start '<' in + scanner.line <- + scanner.line + String_helpers.count scanner.data start stop '\n'; + scanner.p := stop; + emit_text scanner (decode (String.sub scanner.data start (stop - start))); + if stop >= limit then scanner.finished <- true; + true + end + let run scanner foreign = let data = scanner.data in let cs = scanner.cs in @@ -706,6 +724,7 @@ let run scanner foreign = cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true end + else if scan_data_text scanner then () else begin begin let state = { keys = 0; trans = 0 } in diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 50b17fb..38eb4dc 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -171,6 +171,26 @@ let create data = write = 0; finished = false} +let scan_data_text scanner = + let start = !(scanner.p) in + let limit = !(scanner.eof) in + if + !(scanner.cs) <> htmlstream_en_main + || !(scanner.mark) >= 0 + || start >= limit + || scanner.data.[start] = '<' + then false + else begin + let stop = String_helpers.find scanner.data start '<' in + scanner.line <- + scanner.line + String_helpers.count scanner.data start stop '\n'; + scanner.p := stop; + emit_text scanner + (decode (String.sub scanner.data start (stop - start))); + if stop >= limit then scanner.finished <- true; + true + end + let run scanner foreign = let data = scanner.data in let cs = scanner.cs in @@ -279,6 +299,7 @@ let run scanner foreign = cs := htmlstream_en_main; if !p >= !eof then scanner.finished <- true end + else if scan_data_text scanner then () else begin %%write exec; if diff --git a/src/lite/string_helpers.c b/src/lite/string_helpers.c new file mode 100644 index 0000000..f51b11a --- /dev/null +++ b/src/lite/string_helpers.c @@ -0,0 +1,31 @@ +/* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. */ + +#include <caml/mlvalues.h> +#include <string.h> + +CAMLprim value markup_lite_string_helpers_find( + value string, value start, value character) +{ + const char *data = String_val(string); + const mlsize_t length = caml_string_length(string); + const mlsize_t offset = Long_val(start); + const char *found = + memchr(data + offset, Int_val(character), length - offset); + return Val_long(found == NULL ? length : (mlsize_t)(found - data)); +} + +CAMLprim value markup_lite_string_helpers_count( + value string, value start, value stop, value character) +{ + const unsigned char *data = (const unsigned char *)String_val(string); + const mlsize_t first = Long_val(start); + const mlsize_t last = Long_val(stop); + const unsigned char byte = Int_val(character); + mlsize_t count = 0; + + for (mlsize_t index = first; index < last; ++index) + count += data[index] == byte; + + return Val_long(count); +} diff --git a/src/lite/string_helpers.ml b/src/lite/string_helpers.ml new file mode 100644 index 0000000..64031ba --- /dev/null +++ b/src/lite/string_helpers.ml @@ -0,0 +1,20 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +external unsafe_find : string -> int -> char -> int + = "markup_lite_string_helpers_find" +[@@noalloc] + +external unsafe_count : string -> int -> int -> char -> int + = "markup_lite_string_helpers_count" +[@@noalloc] + +let find string start character = + if start < 0 || start > String.length string then + invalid_arg "String_helpers.find"; + unsafe_find string start character + +let count string start stop character = + if start < 0 || stop < start || stop > String.length string then + invalid_arg "String_helpers.count"; + unsafe_count string start stop character From 1f8ce8d9eba22449e290b4068f816e311f30e2e2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 10:10:51 -0400 Subject: [PATCH 091/109] Record misnested SVG parser loop --- test/lite/dune | 2 +- test/lite/lite_baseline_regression.ml | 31 ++++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/test/lite/dune b/test/lite/dune index 02acba5..a4905b0 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -32,7 +32,7 @@ (executable (name lite_baseline_regression) (modules lite_baseline_regression) - (libraries markup markup.common markup.lite ounit2)) + (libraries markup markup.common markup.lite ounit2 unix)) (executable (name lite_main_entity_regression) diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index 32d09d5..ebb56cf 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -44,6 +44,35 @@ let terminates = "in row misnested math" >:: fun _ -> ignore (lite `Document "<table><tr><math></tr><td><tr><b><math>0") +exception Parser_timeout + +let baseline_loops = + "in row misnested svg" >:: fun _ -> + let html = "<table><tr><math></tr><td><tr><b><svg>d" in + ignore (lite `Document html); + let previous_handler = + Sys.signal Sys.sigalrm + (Sys.Signal_handle (fun _ -> raise_notrace Parser_timeout)) + in + let previous_timer = + Unix.setitimer Unix.ITIMER_REAL { it_interval = 0.; it_value = 0.25 } + in + let outcome = + Fun.protect + ~finally:(fun () -> + ignore (Unix.setitimer Unix.ITIMER_REAL previous_timer); + Sys.set_signal Sys.sigalrm previous_handler) + (fun () -> + try + ignore (baseline `Document html); + `Terminated + with Parser_timeout -> `Timed_out) + in + assert_equal + ~printer:(function + | `Terminated -> "terminated" | `Timed_out -> "timed out") + `Timed_out outcome + let () = run_test_tt_main ("Lite vs baseline regressions" @@ -222,5 +251,5 @@ let () = agrees ~context:(`Fragment "svg") "complete candidate" "<p></p><style></x>"; ]; - "termination" >::: [ terminates ]; + "termination" >::: [ terminates; baseline_loops ]; ]) From 9608330abee649de9532e6061ae86f37c78029f4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 10:19:07 -0400 Subject: [PATCH 092/109] fix (baseline): prevent infinite loop --- src/baseline/html_parser.ml | 2 ++ test/lite/lite_baseline_regression.ml | 17 +++++++---------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/baseline/html_parser.ml b/src/baseline/html_parser.ml index 19c906b..6643c6e 100644 --- a/src/baseline/html_parser.ml +++ b/src/baseline/html_parser.ml @@ -2474,6 +2474,7 @@ let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, se close_cell l (fun () -> Active.clear_until_marker active_formatting_elements; push tokens v; + current_mode := in_row_mode; in_row_mode ()) | l, `End {name = @@ -2488,6 +2489,7 @@ let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, se close_cell l (fun () -> Active.clear_until_marker active_formatting_elements; push tokens v; + current_mode := in_row_mode; in_row_mode ()) | l, `Start ({name = "select"} as t) -> diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index ebb56cf..c0f111b 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -46,10 +46,9 @@ let terminates = exception Parser_timeout -let baseline_loops = +let bounded_agreement = "in row misnested svg" >:: fun _ -> let html = "<table><tr><math></tr><td><tr><b><svg>d" in - ignore (lite `Document html); let previous_handler = Sys.signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise_notrace Parser_timeout)) @@ -63,15 +62,13 @@ let baseline_loops = ignore (Unix.setitimer Unix.ITIMER_REAL previous_timer); Sys.set_signal Sys.sigalrm previous_handler) (fun () -> - try - ignore (baseline `Document html); - `Terminated + try `Parsed (baseline `Document html) with Parser_timeout -> `Timed_out) in - assert_equal - ~printer:(function - | `Terminated -> "terminated" | `Timed_out -> "timed out") - `Timed_out outcome + match outcome with + | `Timed_out -> assert_failure "baseline parser timed out" + | `Parsed expected -> + assert_equal ~printer:print_signals expected (lite `Document html) let () = run_test_tt_main @@ -251,5 +248,5 @@ let () = agrees ~context:(`Fragment "svg") "complete candidate" "<p></p><style></x>"; ]; - "termination" >::: [ terminates; baseline_loops ]; + "termination" >::: [ terminates; bounded_agreement ]; ]) From cb628ec58a232a95089e2a9e9267eedd0a956f91 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 11:46:00 -0400 Subject: [PATCH 093/109] Format Lite oracle --- test/lite/oracle.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lite/oracle.ml b/test/lite/oracle.ml index 109fe46..affb885 100644 --- a/test/lite/oracle.ml +++ b/test/lite/oracle.ml @@ -33,8 +33,8 @@ let adapt html : (Markup.location * Markup.Internals.token) list = let emit_text text = String.split_on_char '\x00' text |> List.iteri (fun i part -> - if i > 0 then emit (`Char 0); - if part <> "" then emit (`String part)) + if i > 0 then emit (`Char 0); + if part <> "" then emit (`String part)) in let step = function | HS.Text raw -> emit_text (decode raw) From 902ddd2aa5c423f49395106a853901f24002fd4e Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 11:46:00 -0400 Subject: [PATCH 094/109] Fix baseline buffered foreign text runs --- src/baseline/html_parser.ml | 11 +++++++++++ test/lite/lite_fuzz_regression.ml | 15 +++++++++++++++ 2 files changed, 26 insertions(+) diff --git a/src/baseline/html_parser.ml b/src/baseline/html_parser.ml index 6643c6e..1758996 100644 --- a/src/baseline/html_parser.ml +++ b/src/baseline/html_parser.ml @@ -728,6 +728,7 @@ sig type t val create : Stack.t -> t + val buffering : t -> bool val accumulate : t -> location -> signal -> bool @@ -748,6 +749,8 @@ struct enabled = false; position = Element.dummy} + let buffering subtree_buffer = subtree_buffer.enabled + let accumulate subtree_buffer l s = if not subtree_buffer.enabled then true else begin @@ -2860,6 +2863,14 @@ let parse ?depth_limit requested_context report (tokens, set_tokenizer_state, se add_character l u_rep; mode ()) + | l, `String s when s <> "" && Subtree.buffering subtree_buffer -> + let decoded = String.get_utf_8_uchar s 0 in + let width = Uchar.utf_decode_length decoded in + if width < String.length s then + push tokens (l, `String (String.sub s width (String.length s - width))); + foreign_content mode force_html + (l, `Char (Uchar.to_int (Uchar.utf_decode_uchar decoded))) + | l, `String s -> add_string l s; if not @@ is_whitespace_only s then frameset_ok := false; diff --git a/test/lite/lite_fuzz_regression.ml b/test/lite/lite_fuzz_regression.ml index 1048045..caab3be 100644 --- a/test/lite/lite_fuzz_regression.ml +++ b/test/lite/lite_fuzz_regression.ml @@ -22,6 +22,20 @@ let agrees name html = name >:: fun _ -> assert_equal ~printer:print_signals (oracle html) (lite html) +let adapted_oracle html = + let tokens = Oracle.adapt html in + collect Markup.iter + (Oracle.parse_adapted ~context:`Document (fun _ _ -> ()) tokens) + +let adapted_lite html = + let tokens = Oracle.adapt html in + collect Markup_lite.iter + (Oracle.parse_lite_adapted ~context:`Document (fun _ _ -> ()) tokens) + +let adapted_agrees name html = + name >:: fun _ -> + assert_equal ~printer:print_signals (adapted_oracle html) (adapted_lite html) + let lite_parses name html = name >:: fun _ -> ignore (lite html) let rawtext_failures = @@ -76,6 +90,7 @@ let entity_guards = let tree_builder_failures = [ + adapted_agrees "foreign buffered text run" "<math><b><svg>eP"; agrees "Lite require_current_element" "<template><td><svg></td><tbody/><title></title><></U>"; lite_parses "empty stack after formatting element" From 2339d6f73f36d9b3e050d05c329c86cc5617e731 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 11:51:10 -0400 Subject: [PATCH 095/109] Skip known baseline invariant failures in the fuzzer --- test/fuzz/lite_diff_fuzz.ml | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/test/fuzz/lite_diff_fuzz.ml b/test/fuzz/lite_diff_fuzz.ml index 06aa741..c95f211 100644 --- a/test/fuzz/lite_diff_fuzz.ml +++ b/test/fuzz/lite_diff_fuzz.ml @@ -107,11 +107,12 @@ let compare_lists what to_string expected actual = let compare_signals = compare_lists "signal" signal let compare_errors = compare_lists "error" error -let check input = - let context, body = context_of_input input in - (* HtmlStream adaptation is intentionally performed once. *) - let tokens = Oracle.adapt body in - match (oracle context tokens, lite context tokens) with +let known_oracle_invariant_failure = function + | Raised ("Failure(\"require_current_element: None\")", _) -> true + | _ -> false + +let compare_outcomes expected actual = + match (expected, actual) with | Signals (expected, expected_errors), Signals (actual, actual_errors) -> compare_signals expected actual; compare_errors expected_errors actual_errors @@ -124,4 +125,12 @@ let check input = | Signals _, Raised (exception_, _) -> crash "Lite raised but oracle returned signals: %S" exception_ +let check input = + let context, body = context_of_input input in + (* HtmlStream adaptation is intentionally performed once. *) + let tokens = Oracle.adapt body in + let expected = oracle context tokens in + if known_oracle_invariant_failure expected then () + else compare_outcomes expected (lite context tokens) + let () = match read_input stdin with Some input -> check input | None -> () From 18d7f61ac5ef0f1d39d0873e3afef6beb0d179bc Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 12:40:01 -0400 Subject: [PATCH 096/109] Use successful baseline parses as fuzz oracles --- test/fuzz/lite_diff_fuzz.ml | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/test/fuzz/lite_diff_fuzz.ml b/test/fuzz/lite_diff_fuzz.ml index c95f211..9005a21 100644 --- a/test/fuzz/lite_diff_fuzz.ml +++ b/test/fuzz/lite_diff_fuzz.ml @@ -107,30 +107,19 @@ let compare_lists what to_string expected actual = let compare_signals = compare_lists "signal" signal let compare_errors = compare_lists "error" error -let known_oracle_invariant_failure = function - | Raised ("Failure(\"require_current_element: None\")", _) -> true - | _ -> false - -let compare_outcomes expected actual = - match (expected, actual) with - | Signals (expected, expected_errors), Signals (actual, actual_errors) -> +let compare_with_oracle expected expected_errors = function + | Signals (actual, actual_errors) -> compare_signals expected actual; compare_errors expected_errors actual_errors - | Raised (expected, expected_errors), Raised (actual, actual_errors) -> - if expected <> actual then - crash "exceptions differ: oracle=%S lite=%S" expected actual; - compare_errors expected_errors actual_errors - | Raised (exception_, _), Signals _ -> - crash "oracle raised but Lite returned signals: %S" exception_ - | Signals _, Raised (exception_, _) -> - crash "Lite raised but oracle returned signals: %S" exception_ + | Raised (exception_, _) -> crash "Lite raised: %S" exception_ let check input = let context, body = context_of_input input in (* HtmlStream adaptation is intentionally performed once. *) let tokens = Oracle.adapt body in - let expected = oracle context tokens in - if known_oracle_invariant_failure expected then () - else compare_outcomes expected (lite context tokens) + match oracle context tokens with + | Raised _ -> () + | Signals (expected, expected_errors) -> + compare_with_oracle expected expected_errors (lite context tokens) let () = match read_input stdin with Some input -> check input | None -> () From 6e29dd625b3b0a113bab1cb2f587cbfe9fff8c36 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 12:41:02 -0400 Subject: [PATCH 097/109] Add selectable native Lite fuzzing --- Makefile | 21 ++++++++++++-- test/fuzz/dune | 4 +++ test/fuzz/lite_native_fuzz.ml | 52 +++++++++++++++++++++++++++++++++++ 3 files changed, 74 insertions(+), 3 deletions(-) create mode 100644 test/fuzz/lite_native_fuzz.ml diff --git a/Makefile b/Makefile index 12936c1..e14fc68 100644 --- a/Makefile +++ b/Makefile @@ -41,8 +41,19 @@ test-lite : $(LITE_PARSER_TEST_EXE) $(LITE_TEST_CORPUS) $(LITE_WRITER_TEST_EXE) $(LITE_TEST_CORPUS) +LITE_AFL_MODE ?= diff +ifeq ($(LITE_AFL_MODE),diff) +LITE_AFL_TARGET := test/fuzz/lite_diff_fuzz.exe LITE_AFL_EXE := _build-afl/default/test/fuzz/lite_diff_fuzz.exe -LITE_AFL_OUTPUT ?= _fuzz/lite +LITE_AFL_DEFAULT_OUTPUT := _fuzz/lite +else ifeq ($(LITE_AFL_MODE),native) +LITE_AFL_TARGET := test/fuzz/lite_native_fuzz.exe +LITE_AFL_EXE := _build-afl/default/test/fuzz/lite_native_fuzz.exe +LITE_AFL_DEFAULT_OUTPUT := _fuzz/lite-native +else +$(error LITE_AFL_MODE must be diff or native) +endif +LITE_AFL_OUTPUT ?= $(LITE_AFL_DEFAULT_OUTPUT) AFL_FUZZ ?= $(if $(wildcard _tools/AFLplusplus/afl-fuzz),_tools/AFLplusplus/afl-fuzz,afl-fuzz) AFL_WHATSUP ?= $(if $(wildcard _tools/AFLplusplus/afl-whatsup),_tools/AFLplusplus/afl-whatsup,afl-whatsup) J ?= 4 @@ -51,9 +62,9 @@ J ?= 4 test-lite-afl : @command -v $(AFL_FUZZ) >/dev/null || { \ echo "$(AFL_FUZZ) not found; install AFL or set AFL_FUZZ" >&2; exit 1; } - dune build --build-dir _build-afl --profile afl \ - test/fuzz/lite_diff_fuzz.exe + dune build --build-dir _build-afl --profile afl $(LITE_AFL_TARGET) @set -eu; \ + echo "fuzzing mode: $(LITE_AFL_MODE)"; \ case "$(J)" in ''|*[!0-9]*|0) echo "J must be a positive integer" >&2; exit 2;; esac; \ mkdir -p $(LITE_AFL_OUTPUT); \ pids=''; \ @@ -80,6 +91,10 @@ test-lite-afl : done; \ wait +.PHONY : test-lite-afl-native +test-lite-afl-native : + $(MAKE) test-lite-afl LITE_AFL_MODE=native + .PHONY : test-lite-afl-report test-lite-afl-report : $(AFL_WHATSUP) -d $(LITE_AFL_OUTPUT) diff --git a/test/fuzz/dune b/test/fuzz/dune index 5fd15f6..fa231a4 100644 --- a/test/fuzz/dune +++ b/test/fuzz/dune @@ -6,3 +6,7 @@ (executable (name lite_diff_fuzz) (libraries lite_test_oracle markup markup.common markup.lite unix)) + +(executable + (name lite_native_fuzz) + (libraries markup.lite unix)) diff --git a/test/fuzz/lite_native_fuzz.ml b/test/fuzz/lite_native_fuzz.ml new file mode 100644 index 0000000..ef7c989 --- /dev/null +++ b/test/fuzz/lite_native_fuzz.ml @@ -0,0 +1,52 @@ +let maximum_input_length = 1024 * 1024 + +let read_input channel = + let buffer = Buffer.create 4096 in + let bytes = Bytes.create 65536 in + let rec read total = + let count = input channel bytes 0 (Bytes.length bytes) in + if count = 0 then Some (Buffer.contents buffer) + else + let total = total + count in + if total > maximum_input_length then None + else begin + Buffer.add_subbytes buffer bytes 0 count; + read total + end + in + read 0 + +(* "FRAGMENT <name>\n<body>" parses <body> in fragment context <name>; + anything else parses the whole input as a document. *) +let context_of_input input : [ `Document | `Fragment of string ] * string = + let prefix = "FRAGMENT " in + let prefix_length = String.length prefix in + if + String.length input >= prefix_length + && String.sub input 0 prefix_length = prefix + then + match String.index_from_opt input prefix_length '\n' with + | Some newline -> + ( `Fragment (String.sub input prefix_length (newline - prefix_length)), + String.sub input (newline + 1) (String.length input - newline - 1) ) + | None -> + ( `Fragment + (String.sub input prefix_length + (String.length input - prefix_length)), + "" ) + else (`Document, input) + +let crash exception_ = + Printf.eprintf "markup.lite native parser raised: %s\n%!" + (Printexc.to_string exception_); + Unix.kill (Unix.getpid ()) Sys.sigabrt; + exit 2 + +let check input = + let context, body = context_of_input input in + try + Markup_lite.parse_html ~context ~report:(fun _ _ -> ()) body + |> Markup_lite.iter (fun _ -> ()) + with exn -> crash exn + +let () = match read_input stdin with Some input -> check input | None -> () From 9e0040ae488e709f3606d85ed54190ef0ea364b3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 12:41:26 -0400 Subject: [PATCH 098/109] Collect fuzz parser errors after signals --- test/fuzz/lite_diff_fuzz.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/fuzz/lite_diff_fuzz.ml b/test/fuzz/lite_diff_fuzz.ml index 9005a21..b9fbc96 100644 --- a/test/fuzz/lite_diff_fuzz.ml +++ b/test/fuzz/lite_diff_fuzz.ml @@ -51,7 +51,9 @@ type outcome = let run parse collect_signals = let errors = ref [] in let report location error = errors := (location, error) :: !errors in - try Signals (collect_signals (parse report), List.rev !errors) + try + let signals = collect_signals (parse report) in + Signals (signals, List.rev !errors) with exn -> Raised (Printexc.to_string exn, List.rev !errors) let oracle context tokens = From 6e37297c4a57647aa1fd15d3518f817d85e7a107 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Fri, 28 Aug 2026 17:40:41 +0000 Subject: [PATCH 099/109] add explicit UTF-8 mode to Markup_lite --- src/lite/markup_lite.ml | 10 ++++++++-- src/lite/markup_lite.mli | 2 ++ src/lite/token_source.ml | 5 +++-- src/lite/token_source.mli | 1 + test/lite/lite_baseline_regression.ml | 15 +++++++++++++++ 5 files changed, 29 insertions(+), 4 deletions(-) diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index c9640fd..47600b9 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -22,6 +22,7 @@ type doctype = Markup_common.doctype = { } type signal = Markup_common.signal +type encoding = [ `Auto | `UTF_8 ] module Token_tag = Common.Token_tag @@ -50,10 +51,15 @@ let parse_source report context depth_limit tokens = |> Markup_common.Stream.Private.to_stream |> fun stream -> (stream : (signal, sync) stream) -let parse_html ?(report = fun _ _ -> ()) +let parse_html ?(report = fun _ _ -> ()) ?(encoding = `Auto) ?(context : [ `Document | `Fragment of string ] = `Document) ?depth_limit html = - Token_source.create html |> parse_source report context depth_limit + let source = + match encoding with + | `Auto -> Token_source.create html + | `UTF_8 -> Token_source.create_utf_8 html + in + parse_source report context depth_limit source let parse_tokens ?(report = fun _ _ -> ()) ?(context : [ `Document | `Fragment of string ] = `Document) ?depth_limit diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index e12366e..f15d1f1 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -24,6 +24,7 @@ type doctype = Markup_common.doctype = { } type signal = Markup_common.signal +type encoding = [ `Auto | `UTF_8 ] module Token_tag : sig type t = { @@ -49,6 +50,7 @@ val signal_to_string : [< signal ] -> string val parse_html : ?report:(location -> Error.t -> unit) -> + ?encoding:encoding -> ?context:[ `Document | `Fragment of string ] -> ?depth_limit:int -> string -> diff --git a/src/lite/token_source.ml b/src/lite/token_source.ml index b73646d..d478905 100644 --- a/src/lite/token_source.ml +++ b/src/lite/token_source.ml @@ -60,8 +60,7 @@ let strip_leading_bom html = let start = if not (has_bom 0) then 0 else if has_bom 3 then 6 else 3 in if start = 0 then html else String.sub html start (length - start) -let create html = - let html = Encoding.decode_html html in +let create_utf_8 html = let html = if valid_utf_8 html then html else replace_malformed html in let html = strip_leading_bom html in let html = normalize_newlines html in @@ -72,6 +71,8 @@ let create html = native_text_runs = true; } +let create html = Encoding.decode_html html |> create_utf_8 + let of_tokens tokens = let pushed = List.map (fun ((line, column), token) -> { token; line; column }) tokens diff --git a/src/lite/token_source.mli b/src/lite/token_source.mli index fdaa48d..d5d5f4d 100644 --- a/src/lite/token_source.mli +++ b/src/lite/token_source.mli @@ -7,6 +7,7 @@ type location_out = { mutable line : int; mutable column : int } type t val create : string -> t +val create_utf_8 : string -> t val of_tokens : (location * Html_tokenizer.token) list -> t val native_text_runs : t -> bool val location : unit -> location_out diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index c0f111b..b4e98c9 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -29,6 +29,19 @@ let agrees ?(context = `Document) name html = assert_equal ~printer:print_signals (baseline context html) (lite context html) +let agrees_utf_8 name html = + name >:: fun _ -> + let expected = + Markup.string html + |> Markup.parse_html ~encoding:Markup.Encoding.utf_8 ~context:`Document + |> Markup.signals |> Markup.to_list + in + let actual = + Markup_lite.parse_html ~encoding:`UTF_8 ~context:`Document html + |> collect Markup_lite.iter + in + assert_equal ~printer:print_signals expected actual + let agrees_with_text ?(context = `Document) name html text = name >:: fun _ -> let expected = baseline context html in @@ -115,6 +128,8 @@ let () = ]; "declared encoding" >::: [ + agrees_utf_8 "explicit UTF-8 ignores declaration" + "<meta charset=windows-1252><p>\xC3\xA9"; agrees "windows-1251" "<meta charset=windows-1251><p>\xCF\xF0\xE8\xE2\xE5\xF2"; agrees "baseline windows-1251 D0 mapping" From 47993c74552319fda698964c6b243561615f8379 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Tue, 1 Sep 2026 11:32:53 -0400 Subject: [PATCH 100/109] Remove dead test_ragel_parser.ml Co-Authored-By: Claude Fable 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01MH5DguW7uz8zgqsrHqtcHV --- test/test.ml | 1 - test/test_ragel_parser.ml | 1717 ------------------------------------- 2 files changed, 1718 deletions(-) delete mode 100644 test/test_ragel_parser.ml diff --git a/test/test.ml b/test/test.ml index c5f4544..7e20574 100644 --- a/test/test.ml +++ b/test/test.ml @@ -22,7 +22,6 @@ let suite = Test_utility.tests; Test_integration.tests; Test_ragel_tokenizer.tests; - (* Test_ragel_parser.tests; *) ] let () = diff --git a/test/test_ragel_parser.ml b/test/test_ragel_parser.ml deleted file mode 100644 index 02b2018..0000000 --- a/test/test_ragel_parser.ml +++ /dev/null @@ -1,1717 +0,0 @@ -open OUnit2 -open Test_support -open Markup__Common -module Kstream = Markup__Kstream - -let print_token_stream stream = - let print_token (_, token) _throw k = - print_endline @@ String.escaped @@ token_to_string token; - k () - in - print_endline "tokens:"; - Kstream.iter print_token stream (wrong_k "failed") ignore - -let print_signal_stream stream = - let print_token (_, token) _throw k = - print_endline @@ String.escaped @@ signal_to_string token; - k () - in - print_endline "tokens:"; - Kstream.iter print_token stream (wrong_k "failed") ignore - -let doctype = - `Doctype - { - doctype_name = Some "html"; - public_identifier = None; - system_identifier = None; - raw_text = None; - force_quirks = false; - } - -let start_element name = `Start_element ((html_ns, name), []) - -let expect ?prefix ?(context = Some `Document) text signals = - (* ragel parser doesn't emit bad token Error, filter them out *) - let signals = - List.filter (function - | _, _, E (`Bad_token _) | _, _, E (`Bad_document "doctype should be first") - -> false - | _ -> true) signals - in - - let report, iterate, ended = - expect_no_location_signals ?prefix signal_to_string text signals - in - - let token_stream = - text |> Ragel_html_tokenizer.tokenize |> Kstream.of_list - in - - let signal_stream = - Markup__Html_parser.parse context report (token_stream, ignore, ignore) - in - (* print_signal_stream signal_stream; *) - iter iterate signal_stream; - ended () - -let tests = - [ - ( "html.parser.basic" >:: fun _ -> - expect "<!DOCTYPE html><html><head></head><body></body></html>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 22, S (start_element "head")); - (1, 28, S `End_element); - (1, 35, S (start_element "body")); - (1, 55, S `End_element); - (1, 55, S `End_element); - ]; - - expect ~prefix:true " <!--foo--> <!DOCTYPE html>" - [ (1, 2, S (`Comment "foo")); (1, 13, S doctype) ]; - - expect ~prefix:true "<!DOCTYPE html> <!--foo--> <html></html>" - [ - (1, 1, S doctype); - (1, 17, S (`Comment "foo")); - (1, 28, S (start_element "html")); - ]; - - expect ~prefix:true "<html> <!--foo--> <head></head></html>" - [ - (1, 1, S (start_element "html")); - (1, 8, S (`Comment "foo")); - (1, 19, S (start_element "head")); - ] ); - ( "html.parser.implicit-top-level" >:: fun _ -> - expect "<!DOCTYPE html>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 16, S (start_element "head")); - (1, 16, S `End_element); - (1, 16, S (start_element "body")); - (1, 16, S `End_element); - (1, 16, S `End_element); - ]; - - expect "<!DOCTYPE html><html></html>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 22, S (start_element "head")); - (1, 22, S `End_element); - (1, 22, S (start_element "body")); - (1, 29, S `End_element); - (1, 29, S `End_element); - ]; - - expect "<!DOCTYPE html><head></head>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 16, S (start_element "head")); - (1, 22, S `End_element); - (1, 29, S (start_element "body")); - (1, 29, S `End_element); - (1, 29, S `End_element); - ]; - - expect "<!DOCTYPE html><body></body>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 16, S (start_element "head")); - (1, 16, S `End_element); - (1, 16, S (start_element "body")); - (1, 29, S `End_element); - (1, 29, S `End_element); - ]; - - expect "<!DOCTYPE html><p></p>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 16, S (start_element "head")); - (1, 16, S `End_element); - (1, 16, S (start_element "body")); - (1, 16, S (start_element "p")); - (1, 19, S `End_element); - (1, 23, S `End_element); - (1, 23, S `End_element); - ]; - - expect "<!DOCTYPE html><title></title>" - [ - (1, 1, S doctype); - (1, 16, S (start_element "html")); - (1, 16, S (start_element "head")); - (1, 16, S (start_element "title")); - (1, 23, S `End_element); - (1, 31, S `End_element); - (1, 31, S (start_element "body")); - (1, 31, S `End_element); - (1, 31, S `End_element); - ] ); - ( "html.parser.no-doctype" >:: fun _ -> - expect ~prefix:true "<title>foo</title>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S (start_element "title")); - (1, 8, S (`Text [ "foo" ])); - ] ); - ( "html.parser.double-doctype" >:: fun _ -> - expect ~prefix:true "<!DOCTYPE html><!DOCTYPE html><html></html>" - [ - (1, 1, S doctype); - (1, 16, E (`Bad_document "doctype should be first")); - (1, 31, S (start_element "html")); - ] ); - ( "html.parser.end-before-html" >:: fun _ -> - expect ~prefix:true "</p><html></html>" - [ (1, 1, E (`Unmatched_end_tag "p")); (1, 5, S (start_element "html")) ] - ); - ( "html.parser.junk-before-head" >:: fun _ -> - expect ~prefix:true "<html><!DOCTYPE html><html></p><head></head></html>" - [ - (1, 1, S (start_element "html")); - (1, 7, E (`Bad_document "doctype should be first")); - (1, 22, E (`Misnested_tag ("html", "html", []))); - (1, 28, E (`Unmatched_end_tag "p")); - (1, 32, S (start_element "head")); - ] ); - ( "html.parser.head" >:: fun _ -> - expect ~prefix:true "<head> <!--foo--><link><link/><meta><meta/></head>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 7, S (`Text [ " " ])); - (1, 8, S (`Comment "foo")); - (1, 18, S (start_element "link")); - (1, 18, S `End_element); - (1, 24, S (start_element "link")); - (1, 24, S `End_element); - (1, 31, S (start_element "meta")); - (1, 31, S `End_element); - (1, 37, S (start_element "meta")); - (1, 37, S `End_element); - (1, 44, S `End_element); - (1, 51, S (start_element "body")); - ] ); - ( "html.parser.style" >:: fun _ -> - expect ~prefix:true "<head><style>foo</head>&lt;</style></head>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 7, S (start_element "style")); - (1, 14, S (`Text [ "foo</head>&lt;" ])); - (1, 28, S `End_element); - (1, 36, S `End_element); - (1, 43, S (start_element "body")); - ] ); - ( "html.parser.title" >:: fun _ -> - expect ~prefix:true "<head><title>foo</head>&lt;</title></head>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 7, S (start_element "title")); - (1, 14, S (`Text [ "foo</head><" ])); - (1, 28, S `End_element); - (1, 36, S `End_element); - (1, 43, S (start_element "body")); - ] ); - ( "html.parser.script" >:: fun _ -> - expect ~prefix:true "<head><script><!--foo</head>&lt;bar</script></head>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 7, S (start_element "script")); - (1, 15, S (`Text [ "<!--foo</head>&lt;bar" ])); - (1, 36, S `End_element); - (1, 45, S `End_element); - (1, 52, S (start_element "body")); - ] ); - ( "html.parser.junk-in-head" >:: fun _ -> - expect ~prefix:true "<head><!DOCTYPE html><html><head></p></head>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 7, E (`Bad_document "doctype should be first")); - (1, 22, E (`Misnested_tag ("html", "head", []))); - (1, 28, E (`Misnested_tag ("head", "head", []))); - (1, 34, E (`Unmatched_end_tag "p")); - (1, 38, S `End_element); - (1, 45, S (start_element "body")); - ] ); - ( "html.parser.junk-after-head" >:: fun _ -> - expect ~prefix:true - "<head></head> <!--foo--><!DOCTYPE html><html><meta><head></p><body>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 7, S `End_element); - (1, 14, S (`Text [ " " ])); - (1, 15, S (`Comment "foo")); - (1, 25, E (`Bad_document "doctype should be first")); - (1, 40, E (`Misnested_tag ("html", "html", []))); - (1, 46, E (`Misnested_tag ("meta", "html", []))); - (1, 46, S (start_element "meta")); - (1, 46, S `End_element); - (1, 52, E (`Bad_document "duplicate head element")); - (1, 58, E (`Unmatched_end_tag "p")); - (1, 62, S (start_element "body")); - ] ); - ( "html.parser.whitespace-after-head" >:: fun _ -> - expect "<html><head></head> </html>" - [ - (1, 1, S (start_element "html")); - (1, 7, S (start_element "head")); - (1, 13, S `End_element); - (1, 20, S (`Text [ " " ])); - (1, 21, S (start_element "body")); - (1, 28, S `End_element); - (1, 28, S `End_element); - ]; - - expect "<html><head><title>foo</title></head> </html>" - [ - (1, 1, S (start_element "html")); - (1, 7, S (start_element "head")); - (1, 13, S (start_element "title")); - (1, 20, S (`Text [ "foo" ])); - (1, 23, S `End_element); - (1, 31, S `End_element); - (1, 38, S (`Text [ " " ])); - (1, 39, S (start_element "body")); - (1, 46, S `End_element); - (1, 46, S `End_element); - ] ); - ( "html.parser.body-content" >:: fun _ -> - expect "<body><!--foo--> bar</body>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 7, S (`Comment "foo")); - (1, 17, S (`Text [ " bar" ])); - (1, 28, S `End_element); - (1, 28, S `End_element); - ] ); - ( "html.parser.body.whitespace" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - " \n\r\t\x0c&#x0d;" - [ (1, 1, S (`Text [ " \n\n\t\x0c\r" ])) ] ); - ( "html.parser.paragraphs" >:: fun _ -> - expect "<p>foo</p>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S (`Text [ "foo" ])); - (1, 7, S `End_element); - (1, 11, S `End_element); - (1, 11, S `End_element); - ]; - - expect "<p>foo<p>bar<div>baz</div>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S (`Text [ "foo" ])); - (1, 7, S `End_element); - (1, 7, S (start_element "p")); - (1, 10, S (`Text [ "bar" ])); - (1, 13, S `End_element); - (1, 13, S (start_element "div")); - (1, 18, S (`Text [ "baz" ])); - (1, 21, S `End_element); - (1, 27, S `End_element); - (1, 27, S `End_element); - ] ); - ( "html.parser.p.autoclose" >:: fun _ -> - expect - ("<p><address></address><p><article></article><p><aside></aside>\n" - ^ "<p><blockquote></blockquote><p><center></center>\n" - ^ "<p><details></details><p><dialog></dialog><p><dir></dir>\n" - ^ "<p><div></div><p><dl></dl><p><fieldset></fieldset>\n" - ^ "<p><figcaption></figcaption><p><figure></figure>\n" - ^ "<p><footer></footer><p><header></header><p><hgroup></hgroup>\n" - ^ "<p><main></main><p><nav></nav><p><ol></ol><p><p></p>\n" - ^ "<p><section></section><p><summary></summary><p><ul></ul>\n" - ^ "<p><h1></h1><p><h2></h2><p><h3></h3><p><h4></h4><p><h5></h5>\n" - ^ "<p><h6></h6>") - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "address")); - (1, 13, S `End_element); - (1, 23, S (start_element "p")); - (1, 26, S `End_element); - (1, 26, S (start_element "article")); - (1, 35, S `End_element); - (1, 45, S (start_element "p")); - (1, 48, S `End_element); - (1, 48, S (start_element "aside")); - (1, 55, S `End_element); - (1, 63, S (`Text [ "\n" ])); - (2, 1, S (start_element "p")); - (2, 4, S `End_element); - (2, 4, S (start_element "blockquote")); - (2, 16, S `End_element); - (2, 29, S (start_element "p")); - (2, 32, S `End_element); - (2, 32, S (start_element "center")); - (2, 40, S `End_element); - (2, 49, S (`Text [ "\n" ])); - (3, 1, S (start_element "p")); - (3, 4, S `End_element); - (3, 4, S (start_element "details")); - (3, 13, S `End_element); - (3, 23, S (start_element "p")); - (3, 26, S `End_element); - (3, 26, S (start_element "dialog")); - (3, 34, S `End_element); - (3, 43, S (start_element "p")); - (3, 46, S `End_element); - (3, 46, S (start_element "dir")); - (3, 51, S `End_element); - (3, 57, S (`Text [ "\n" ])); - (4, 1, S (start_element "p")); - (4, 4, S `End_element); - (4, 4, S (start_element "div")); - (4, 9, S `End_element); - (4, 15, S (start_element "p")); - (4, 18, S `End_element); - (4, 18, S (start_element "dl")); - (4, 22, S `End_element); - (4, 27, S (start_element "p")); - (4, 30, S `End_element); - (4, 30, S (start_element "fieldset")); - (4, 40, S `End_element); - (4, 51, S (`Text [ "\n" ])); - (5, 1, S (start_element "p")); - (5, 4, S `End_element); - (5, 4, S (start_element "figcaption")); - (5, 16, S `End_element); - (5, 29, S (start_element "p")); - (5, 32, S `End_element); - (5, 32, S (start_element "figure")); - (5, 40, S `End_element); - (5, 49, S (`Text [ "\n" ])); - (6, 1, S (start_element "p")); - (6, 4, S `End_element); - (6, 4, S (start_element "footer")); - (6, 12, S `End_element); - (6, 21, S (start_element "p")); - (6, 24, S `End_element); - (6, 24, S (start_element "header")); - (6, 32, S `End_element); - (6, 41, S (start_element "p")); - (6, 44, S `End_element); - (6, 44, S (start_element "hgroup")); - (6, 52, S `End_element); - (6, 61, S (`Text [ "\n" ])); - (7, 1, S (start_element "p")); - (7, 4, S `End_element); - (7, 4, S (start_element "main")); - (7, 10, S `End_element); - (7, 17, S (start_element "p")); - (7, 20, S `End_element); - (7, 20, S (start_element "nav")); - (7, 25, S `End_element); - (7, 31, S (start_element "p")); - (7, 34, S `End_element); - (7, 34, S (start_element "ol")); - (7, 38, S `End_element); - (7, 43, S (start_element "p")); - (7, 46, S `End_element); - (7, 46, S (start_element "p")); - (7, 49, S `End_element); - (7, 53, S (`Text [ "\n" ])); - (8, 1, S (start_element "p")); - (8, 4, S `End_element); - (8, 4, S (start_element "section")); - (8, 13, S `End_element); - (8, 23, S (start_element "p")); - (8, 26, S `End_element); - (8, 26, S (start_element "summary")); - (8, 35, S `End_element); - (8, 45, S (start_element "p")); - (8, 48, S `End_element); - (8, 48, S (start_element "ul")); - (8, 52, S `End_element); - (8, 57, S (`Text [ "\n" ])); - (9, 1, S (start_element "p")); - (9, 4, S `End_element); - (9, 4, S (start_element "h1")); - (9, 8, S `End_element); - (9, 13, S (start_element "p")); - (9, 16, S `End_element); - (9, 16, S (start_element "h2")); - (9, 20, S `End_element); - (9, 25, S (start_element "p")); - (9, 28, S `End_element); - (9, 28, S (start_element "h3")); - (9, 32, S `End_element); - (9, 37, S (start_element "p")); - (9, 40, S `End_element); - (9, 40, S (start_element "h4")); - (9, 44, S `End_element); - (9, 49, S (start_element "p")); - (9, 52, S `End_element); - (9, 52, S (start_element "h5")); - (9, 56, S `End_element); - (9, 61, S (`Text [ "\n" ])); - (10, 1, S (start_element "p")); - (10, 4, S `End_element); - (10, 4, S (start_element "h6")); - (10, 8, S `End_element); - (10, 13, S `End_element); - (10, 13, S `End_element); - ] ); - ( "html.parser.attributes" >:: fun _ -> - expect "<div :class='foo'></div>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - ( 1, - 1, - S (`Start_element ((html_ns, "div"), [ (("", ":class"), "foo") ])) - ); - (1, 19, S `End_element); - (1, 25, S `End_element); - (1, 25, S `End_element); - ] ); - ( "html.parser.links" >:: fun _ -> - expect {|<a href="foo.com?bar=on&acte=123">foo</a>|} - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - ( 1, - 1, - S - (`Start_element - ((html_ns, "a"), [ (("", "href"), "foo.com?bar=on&acte=123") ])) - ); - (1, 35, S (`Text [ "foo" ])); - (1, 38, S `End_element); - (1, 42, S `End_element); - (1, 42, S `End_element); - ]; - - expect {|<a href="foo.com?bar=on&image=on">foo</a>|} - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - ( 1, - 1, - S - (`Start_element - ((html_ns, "a"), [ (("", "href"), "foo.com?bar=on&image=on") ])) - ); - (1, 35, S (`Text [ "foo" ])); - (1, 38, S `End_element); - (1, 42, S `End_element); - (1, 42, S `End_element); - ]; - - expect {|<a href="foo.com?bar=on&image;">foo</a>|} - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - ( 1, - 1, - S - (`Start_element - ((html_ns, "a"), [ (("", "href"), "foo.com?bar=onℑ") ])) ); - (1, 33, S (`Text [ "foo" ])); - (1, 36, S `End_element); - (1, 40, S `End_element); - (1, 40, S `End_element); - ] ); - ( "html.parser.headings" >:: fun _ -> - expect "<h1><h2><h3><h4><h5><h6><h1>foo</h1>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "h1")); - (1, 5, E (`Misnested_tag ("h2", "h1", []))); - (1, 5, S `End_element); - (1, 5, S (start_element "h2")); - (1, 9, E (`Misnested_tag ("h3", "h2", []))); - (1, 9, S `End_element); - (1, 9, S (start_element "h3")); - (1, 13, E (`Misnested_tag ("h4", "h3", []))); - (1, 13, S `End_element); - (1, 13, S (start_element "h4")); - (1, 17, E (`Misnested_tag ("h5", "h4", []))); - (1, 17, S `End_element); - (1, 17, S (start_element "h5")); - (1, 21, E (`Misnested_tag ("h6", "h5", []))); - (1, 21, S `End_element); - (1, 21, S (start_element "h6")); - (1, 25, E (`Misnested_tag ("h1", "h6", []))); - (1, 25, S `End_element); - (1, 25, S (start_element "h1")); - (1, 29, S (`Text [ "foo" ])); - (1, 32, S `End_element); - (1, 37, S `End_element); - (1, 37, S `End_element); - ] ); - ( "html.parser.pre" >:: fun _ -> - expect "<p><pre>foo</pre>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "pre")); - (1, 9, S (`Text [ "foo" ])); - (1, 12, S `End_element); - (1, 18, S `End_element); - (1, 18, S `End_element); - ]; - - expect "<p><pre>\n\nfoo</pre>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "pre")); - (2, 1, S (`Text [ "\nfoo" ])); - (3, 4, S `End_element); - (3, 10, S `End_element); - (3, 10, S `End_element); - ] ); - ( "html.parser.listing.leading-newline" >:: fun _ -> - expect "<listing>\n\nfoo</listing>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "listing")); - (2, 1, S (`Text [ "\nfoo" ])); - (3, 4, S `End_element); - (3, 14, S `End_element); - (3, 14, S `End_element); - ] ); - ( "html.parser.textarea" >:: fun _ -> - expect "<textarea>foo</p></textarea>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "textarea")); - (1, 11, S (`Text [ "foo</p>" ])); - (1, 18, S `End_element); - (1, 29, S `End_element); - (1, 29, S `End_element); - ]; - - expect "<textarea>\n\nfoo</p></textarea>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "textarea")); - (2, 1, S (`Text [ "\nfoo</p>" ])); - (3, 8, S `End_element); - (3, 19, S `End_element); - (3, 19, S `End_element); - ]; - - expect - ~context:(Some (`Fragment "body")) - "<textarea></textarea><p>foo</p>" - [ - (1, 1, S (start_element "textarea")); - (1, 11, S `End_element); - (1, 22, S (start_element "p")); - (1, 25, S (`Text [ "foo" ])); - (1, 28, S `End_element); - ] ); - ( "html.parser.list" >:: fun _ -> - expect "<ul><li>foo<li>bar</ul>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "ul")); - (1, 5, S (start_element "li")); - (1, 9, S (`Text [ "foo" ])); - (1, 12, S `End_element); - (1, 12, S (start_element "li")); - (1, 16, S (`Text [ "bar" ])); - (1, 19, S `End_element); - (1, 19, S `End_element); - (1, 24, S `End_element); - (1, 24, S `End_element); - ] ); - ( "html.parser.definition" >:: fun _ -> - expect "<p><dt>foo<dd>bar" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "dt")); - (1, 8, S (`Text [ "foo" ])); - (1, 11, S `End_element); - (1, 11, S (start_element "dd")); - (1, 15, S (`Text [ "bar" ])); - (1, 18, S `End_element); - (1, 18, S `End_element); - (1, 18, S `End_element); - ] ); - ( "html.parser.plaintext" >:: fun _ -> - expect "<p><plaintext>foo</plaintext></p>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "plaintext")); - (1, 4, E (`Unmatched_start_tag "plaintext")); - (1, 15, S (`Text [ "foo</plaintext></p>" ])); - (1, 34, S `End_element); - (1, 34, S `End_element); - (1, 34, S `End_element); - ] ); - ( "html.parser.table" >:: fun _ -> - expect "<p><table><tr><td>foo</td><td>bar</td></tr></table>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "table")); - (1, 11, S (start_element "tbody")); - (1, 11, S (start_element "tr")); - (1, 15, S (start_element "td")); - (1, 19, S (`Text [ "foo" ])); - (1, 22, S `End_element); - (1, 27, S (start_element "td")); - (1, 31, S (`Text [ "bar" ])); - (1, 34, S `End_element); - (1, 39, S `End_element); - (1, 44, S `End_element); - (1, 44, S `End_element); - (1, 52, S `End_element); - (1, 52, S `End_element); - ] ); - ( "html.parser.select" >:: fun _ -> - expect "<select><option>foo<option>bar</select>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "select")); - (1, 9, S (start_element "option")); - (1, 17, S (`Text [ "foo" ])); - (1, 20, S `End_element); - (1, 20, S (start_element "option")); - (1, 28, S (`Text [ "bar" ])); - (1, 31, S `End_element); - (1, 31, S `End_element); - (1, 40, S `End_element); - (1, 40, S `End_element); - ] ); - ( "html.parser.datalist" >:: fun _ -> - expect "<datalist><option><option></datalist>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "datalist")); - (1, 11, S (start_element "option")); - (1, 19, S `End_element); - (1, 19, S (start_element "option")); - (1, 27, S `End_element); - (1, 27, S `End_element); - (1, 38, S `End_element); - (1, 38, S `End_element); - ] ); - ( "html.parser.datalist.whitespace" >:: fun _ -> - expect "<datalist>\n<option>\n<option>\n</datalist>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "datalist")); - (1, 11, S (`Text [ "\n" ])); - (2, 1, S (start_element "option")); - (2, 9, S (`Text [ "\n" ])); - (3, 1, S `End_element); - (3, 1, S (start_element "option")); - (3, 9, S (`Text [ "\n" ])); - (4, 1, S `End_element); - (4, 1, S `End_element); - (4, 12, S `End_element); - (4, 12, S `End_element); - ] ); - ( "html.parser.ruby" >:: fun _ -> - expect "<rb>a<rt>b" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, E (`Misnested_tag ("rb", "body", []))); - (1, 1, S (start_element "rb")); - (1, 6, E (`Misnested_tag ("rt", "body", []))); - (1, 5, S (`Text [ "a" ])); - (1, 6, S (start_element "rt")); - (1, 6, E (`Unmatched_start_tag "rt")); - (1, 1, E (`Unmatched_start_tag "rb")); - (1, 10, S (`Text [ "b" ])); - (1, 11, S `End_element); - (1, 11, S `End_element); - (1, 11, S `End_element); - (1, 11, S `End_element); - ] ); - ( "html.parser.truncated-body" >:: fun _ -> - expect "<body>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 7, S `End_element); - (1, 7, S `End_element); - ]; - - expect "<body></html>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 14, S `End_element); - (1, 14, S `End_element); - ] ); - ( "html.parser.junk-in-body" >:: fun _ -> - expect "<body>\x00<!DOCTYPE html><html><meta><body attr='value'></body>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 7, E (`Bad_token ("U+0000", "body", "null"))); - (1, 8, E (`Bad_document "doctype should be first")); - (1, 23, E (`Misnested_tag ("html", "body", []))); - (1, 29, S (start_element "meta")); - (1, 29, S `End_element); - (1, 35, E (`Misnested_tag ("body", "body", [ ("attr", "value") ]))); - (1, 61, S `End_element); - (1, 61, S `End_element); - ] ); - ( "html.parser.nested-html-in-body" >:: fun _ -> - expect "<div><html></html>foo</div><div>bar</div>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "div")); - (1, 6, E (`Misnested_tag ("html", "body", []))); - (1, 1, E (`Unmatched_start_tag "div")); - (1, 19, E (`Bad_content "html")); - (1, 19, S (`Text [ "foo" ])); - (1, 22, S `End_element); - (1, 28, S (start_element "div")); - (1, 33, S (`Text [ "bar" ])); - (1, 36, S `End_element); - (1, 42, S `End_element); - (1, 42, S `End_element); - ] ); - ( "html.parser.nested-html-with-body-in-body" >:: fun _ -> - expect "<p><html><body><p></body><br><p>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, E (`Misnested_tag ("html", "body", []))); - (1, 10, E (`Misnested_tag ("body", "body", []))); - (1, 16, S `End_element); - (1, 16, S (start_element "p")); - (1, 26, E (`Bad_document "content after body")); - (1, 26, S (start_element "br")); - (1, 26, S `End_element); - (1, 30, S `End_element); - (1, 30, S (start_element "p")); - (1, 33, S `End_element); - (1, 33, S `End_element); - (1, 33, S `End_element); - ] ); - ( "html.parser.whitespace-at-end" >:: fun _ -> - expect "<html><body></body></html> " - [ - (1, 1, S (start_element "html")); - (1, 7, S (start_element "head")); - (1, 7, S `End_element); - (1, 7, S (start_element "body")); - (1, 27, S (`Text [ " " ])); - (1, 28, S `End_element); - (1, 28, S `End_element); - ] ); - ( "html.parser.foreign" >:: fun _ -> - expect "<body><svg><g/></svg></body>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 7, S (`Start_element ((svg_ns, "svg"), []))); - (1, 12, S (`Start_element ((svg_ns, "g"), []))); - (1, 12, S `End_element); - (1, 16, S `End_element); - (1, 29, S `End_element); - (1, 29, S `End_element); - ] ); - ( "html.parser.foreign.attribute" >:: fun _ -> - expect "<body><svg refX=\"\"><g/></svg></body>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 7, S (`Start_element ((svg_ns, "svg"), [ (("", "refX"), "") ]))); - (1, 20, S (`Start_element ((svg_ns, "g"), []))); - (1, 20, S `End_element); - (1, 24, S `End_element); - (1, 37, S `End_element); - (1, 37, S `End_element); - ] ); - ( "html.parser.foreign.svg-followed-by-html" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<svg><feTile></feTile></svg><b></b>" - [ - (1, 1, S (`Start_element ((svg_ns, "svg"), []))); - (1, 6, S (`Start_element ((svg_ns, "feTile"), []))); - (1, 14, S `End_element); - (1, 23, S `End_element); - (1, 29, S (start_element "b")); - (1, 32, S `End_element); - ] ); - ( "html.parser.reconstruct-active-formatting-elements" >:: fun _ -> - expect "<p><em><strong>foo<p>bar" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 8, E (`Unmatched_start_tag "strong")); - (1, 4, S (start_element "em")); - (1, 8, S (start_element "strong")); - (1, 16, S (`Text [ "foo" ])); - (1, 19, S `End_element); - (1, 19, S `End_element); - (1, 19, S `End_element); - (1, 19, S (start_element "p")); - (1, 8, E (`Unmatched_start_tag "strong")); - (1, 4, E (`Unmatched_start_tag "em")); - (1, 4, S (start_element "em")); - (1, 8, S (start_element "strong")); - (1, 22, S (`Text [ "bar" ])); - (1, 25, S `End_element); - (1, 25, S `End_element); - (1, 25, S `End_element); - (1, 25, S `End_element); - (1, 25, S `End_element); - ] ); - ( "html.parser.close-formatting-elements" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<a>fo</a>o" - [ - (1, 1, S (start_element "a")); - (1, 4, S (`Text [ "fo" ])); - (1, 6, S `End_element); - (1, 10, S (`Text [ "o" ])); - ] ); - ( "html.parser.reset-mode" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<table></table><table></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S `End_element); - (1, 16, S (start_element "table")); - (1, 23, S `End_element); - ] ); - ( "html.parser.fragment" >:: fun _ -> - expect - ~context:(Some (`Fragment "title")) - "</p>" - [ (1, 1, S (`Text [ "</p>" ])) ]; - - expect - ~context:(Some (`Fragment "textarea")) - "</p>" - [ (1, 1, S (`Text [ "</p>" ])) ]; - - expect - ~context:(Some (`Fragment "body")) - "</p>" - [ - (1, 1, E (`Unmatched_end_tag "p")); - (1, 1, S (start_element "p")); - (1, 1, S `End_element); - ]; - - expect - ~context:(Some (`Fragment "body")) - "<!DOCTYPE html>" - [ (1, 1, E (`Bad_document "doctype should be first")) ] ); - ( "html.parser.fragment.rawtext" >:: fun _ -> - expect - ~context:(Some (`Fragment "style")) - "&nbsp;</p>" - [ (1, 1, S (`Text [ "&nbsp;</p>" ])) ] ); - ( "html.parser.fragment.script" >:: fun _ -> - expect - ~context:(Some (`Fragment "script")) - "&nbsp;</p>" - [ (1, 1, S (`Text [ "&nbsp;</p>" ])) ] ); - ( "html.parser.fragment.plaintext" >:: fun _ -> - expect - ~context:(Some (`Fragment "plaintext")) - "&nbsp;</p></plaintext>" - [ (1, 1, S (`Text [ "&nbsp;</p></plaintext>" ])) ] ); - ( "html.parser.context-detection" >:: fun _ -> - expect ~context:None "<p>foo</p>" - [ - (1, 1, S (start_element "p")); - (1, 4, S (`Text [ "foo" ])); - (1, 7, S `End_element); - ]; - - expect ~context:None "<html></html>" - [ - (1, 1, S (start_element "html")); - (1, 7, S (start_element "head")); - (1, 7, S `End_element); - (1, 7, S (start_element "body")); - (1, 14, S `End_element); - (1, 14, S `End_element); - ] ); - ( "html.parser.foreign-context" >:: fun _ -> - expect ~context:None "<g/>" - [ - (1, 1, S (`Start_element ((svg_ns, "g"), []))); (1, 1, S `End_element); - ] ); - ( "html.parser.context-disambiguation" >:: fun _ -> - expect - ~context:(Some (`Fragment "svg")) - "<a></a>" - [ - (1, 1, S (`Start_element ((svg_ns, "a"), []))); (1, 4, S `End_element); - ] ); - ( "html.parser.context-case-insensitivity" >:: fun _ -> - expect - ~context:(Some (`Fragment "SVG")) - "<a></a>" - [ - (1, 1, S (`Start_element ((svg_ns, "a"), []))); (1, 4, S `End_element); - ] ); - ( "html.parser.bad-self-closing-tag" >:: fun _ -> - expect "<p/>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, E (`Bad_token ("/>", "tag", "should not be self-closing"))); - (1, 1, S (start_element "p")); - (1, 5, S `End_element); - (1, 5, S `End_element); - (1, 5, S `End_element); - ] ); - ( "html.parser.image-tag" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<image/>" - [ - (1, 1, E (`Bad_token ("image", "tag", "should be 'img'"))); - (1, 1, S (start_element "img")); - (1, 1, S `End_element); - ] ); - ( "html.parser.nulls" >:: fun _ -> - expect - ~context:(Some (`Fragment "svg")) - "\x00foo" - [ - (1, 1, E (`Bad_token ("U+0000", "foreign content", "null"))); - (1, 1, S (`Text [ "\xef\xbf\xbdfoo" ])); - ]; - - expect - ~context:(Some (`Fragment "body")) - "<table>\x00foo</table>" - [ - (1, 1, S (start_element "table")); - (1, 8, E (`Bad_token ("U+0000", "table", "null"))); - (1, 9, E (`Bad_content "table")); - (1, 10, E (`Bad_content "table")); - (1, 11, E (`Bad_content "table")); - (1, 9, S (`Text [ "foo" ])); - (1, 12, S `End_element); - ]; - - expect - ~context:(Some (`Fragment "select")) - "\x00foo" - [ - (1, 1, E (`Bad_token ("U+0000", "select", "null"))); - (1, 2, S (`Text [ "foo" ])); - ] ); - ( "html.parser.foreign.cdata" >:: fun _ -> - expect ~context:None "<svg><![CDATA[foo]]></svg>" - [ - (1, 1, S (`Start_element ((svg_ns, "svg"), []))); - (1, 15, S (`Text [ "foo" ])); - (1, 21, S `End_element); - ] ); - ( "html.parser.large-text" >:: fun _ -> - with_text_limit 8 (fun () -> - expect ~context:None "foobar" [ (1, 1, S (`Text [ "foobar" ])) ]; - expect ~context:None "foobarbaz" - [ (1, 1, S (`Text [ "foobarba"; "z" ])) ]) ); - ( "html.parser.adoption-agency.simple" >:: fun _ -> - expect ~context:None "foo<b>bar</b>baz" - [ - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "bar" ])); - (1, 10, S `End_element); - (1, 14, S (`Text [ "baz" ])); - ] ); - ( "html.parser.adoption-agency.stray" >:: fun _ -> - expect ~context:None "foo</b>bar" - [ - (1, 4, E (`Unmatched_end_tag "b")); (1, 1, S (`Text [ "foo"; "bar" ])); - ] ); - ( "html.parser.adoption-agency.nested" >:: fun _ -> - expect ~context:None "foo<b>bar<em>baz</em>quux</b>lulz" - [ - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "bar" ])); - (1, 10, S (start_element "em")); - (1, 14, S (`Text [ "baz" ])); - (1, 17, S `End_element); - (1, 22, S (`Text [ "quux" ])); - (1, 26, S `End_element); - (1, 30, S (`Text [ "lulz" ])); - ] ); - ( "html.parser.adoption-agency.nested.stray" >:: fun _ -> - expect ~context:None "foo<b>bar</em>baz</b>quux" - [ - (1, 10, E (`Unmatched_end_tag "em")); - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "bar"; "baz" ])); - (1, 18, S `End_element); - (1, 22, S (`Text [ "quux" ])); - ] ); - ( "html.parser.adoption-agency.interleaved" >:: fun _ -> - expect ~context:None "foo<b>bar<em>baz</b>quux</em>" - [ - (1, 17, E (`Unmatched_end_tag "b")); - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "bar" ])); - (1, 10, S (start_element "em")); - (1, 14, S (`Text [ "baz" ])); - (1, 17, S `End_element); - (1, 17, S `End_element); - (1, 10, S (start_element "em")); - (1, 21, S (`Text [ "quux" ])); - (1, 25, S `End_element); - ] ); - ( "html.parser.adoption-agency.block" >:: fun _ -> - expect ~context:None "foo<b>bar<p>baz</b>quux" - [ - (1, 16, E (`Unmatched_end_tag "b")); - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "bar" ])); - (1, 16, S `End_element); - (1, 10, S (start_element "p")); - (1, 4, S (start_element "b")); - (1, 13, S (`Text [ "baz" ])); - (1, 16, S `End_element); - (1, 20, S (`Text [ "quux" ])); - (1, 24, S `End_element); - ] ); - ( "html.parser.adoption-agency.block.nested" >:: fun _ -> - expect ~context:None "foo<b>bar<em>baz<strong>quux<p>blah</b>lulz" - [ - (1, 36, E (`Unmatched_end_tag "b")); - (1, 17, E (`Unmatched_start_tag "strong")); - (1, 10, E (`Unmatched_start_tag "em")); - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "bar" ])); - (1, 10, S (start_element "em")); - (1, 14, S (`Text [ "baz" ])); - (1, 17, S (start_element "strong")); - (1, 25, S (`Text [ "quux" ])); - (1, 36, S `End_element); - (1, 36, S `End_element); - (1, 36, S `End_element); - (1, 10, S (start_element "em")); - (1, 17, S (start_element "strong")); - (1, 29, S (start_element "p")); - (1, 4, S (start_element "b")); - (1, 32, S (`Text [ "blah" ])); - (1, 36, S `End_element); - (1, 40, S (`Text [ "lulz" ])); - (1, 44, S `End_element); - (1, 44, S `End_element); - (1, 44, S `End_element); - ] ); - ( "html.parser.adoption-agency.reconstructed" >:: fun _ -> - expect ~context:None "<p><b>foo<p>bar<em>baz</b>quux" - [ - (1, 1, S (start_element "p")); - (1, 4, E (`Unmatched_start_tag "b")); - (1, 4, S (start_element "b")); - (1, 7, S (`Text [ "foo" ])); - (1, 10, S `End_element); - (1, 10, S `End_element); - (1, 10, S (start_element "p")); - (1, 23, E (`Unmatched_end_tag "b")); - (1, 16, E (`Unmatched_start_tag "em")); - (1, 4, S (start_element "b")); - (1, 13, S (`Text [ "bar" ])); - (1, 16, S (start_element "em")); - (1, 20, S (`Text [ "baz" ])); - (1, 23, S `End_element); - (1, 23, S `End_element); - (1, 16, S (start_element "em")); - (1, 27, S (`Text [ "quux" ])); - (1, 31, S `End_element); - (1, 31, S `End_element); - ] ); - ( "html.parser.noscript" >:: fun _ -> - expect ~context:None "<head><noscript><meta></noscript></head>" - [ - (1, 1, S (start_element "head")); - (1, 7, S (start_element "noscript")); - (1, 17, S (start_element "meta")); - (1, 17, S `End_element); - (1, 23, S `End_element); - (1, 34, S `End_element); - ] ); - ( "html.parser.noscript.bad" >:: fun _ -> - expect ~context:None - "<head><noscript><!DOCTYPE \ - html><html><head><noscript></head></noscript>" - [ - (1, 1, S (start_element "head")); - (1, 7, S (start_element "noscript")); - (1, 17, E (`Bad_document "doctype should be first")); - (1, 32, E (`Misnested_tag ("html", "noscript", []))); - (1, 38, E (`Misnested_tag ("head", "noscript", []))); - (1, 44, E (`Misnested_tag ("noscript", "noscript", []))); - (1, 54, E (`Unmatched_end_tag "head")); - (1, 61, S `End_element); - (1, 72, S `End_element); - ] ); - ( "html.parser.noscript.head.content" >:: fun _ -> - expect - ~context:(Some (`Fragment "head")) - "<noscript> \t\n<!--foo--> foo</noscript>" - [ - (1, 1, S (start_element "noscript")); - (1, 11, S (`Text [ " \t\n" ])); - (2, 1, S (`Comment "foo")); - (2, 12, E (`Bad_content "noscript")); - (2, 11, S (`Text [ " " ])); - (2, 12, S `End_element); - (2, 12, S (start_element "body")); - (2, 15, E (`Unmatched_end_tag "noscript")); - (2, 12, S (`Text [ "foo" ])); - (2, 26, S `End_element); - ] ); - ( "html.parser.noscript.inferred.content" >:: fun _ -> - expect ~context:None "<noscript> \t\n<!--foo--> foo</noscript>" - [ - (1, 1, S (start_element "noscript")); - (1, 11, S (`Text [ " \t\n" ])); - (2, 1, S (`Comment "foo")); - (2, 11, S (`Text [ " foo" ])); - (2, 15, S `End_element); - ] ); - ( "html.parser.noscript-script.inferred.content" >:: fun _ -> - expect ~context:None "<script>foo</script><noscript>bar</noscript>" - [ - (1, 1, S (start_element "script")); - (1, 9, S (`Text [ "foo" ])); - (1, 12, S `End_element); - (1, 21, S (start_element "noscript")); - (1, 31, S (`Text [ "bar" ])); - (1, 34, S `End_element); - ] ); - ( "html.parser.head.fragment" >:: fun _ -> - expect ~context:None "<base>" - [ (1, 1, S (start_element "base")); (1, 1, S `End_element) ]; - - expect ~context:None "<basefont>" - [ (1, 1, S (start_element "basefont")); (1, 1, S `End_element) ]; - - expect ~context:None "<bgsound>" - [ (1, 1, S (start_element "bgsound")); (1, 1, S `End_element) ]; - - expect ~context:None "<link>" - [ (1, 1, S (start_element "link")); (1, 1, S `End_element) ]; - - expect ~context:None "<meta>" - [ (1, 1, S (start_element "meta")); (1, 1, S `End_element) ]; - - expect ~context:None "<noframes></noframes>" - [ (1, 1, S (start_element "noframes")); (1, 11, S `End_element) ]; - - expect ~context:None "<style></style>" - [ (1, 1, S (start_element "style")); (1, 8, S `End_element) ] ); - ( "html.parser.body.fragment" >:: fun _ -> - expect ~context:None "<body></body>" - [ (1, 1, S (start_element "body")); (1, 14, S `End_element) ] ); - ( "html.parser.body.content-truncated" >:: fun _ -> - expect ~context:None "<p></body></html>foo" - [ - (1, 1, S (start_element "p")); - (1, 4, E (`Unmatched_end_tag "body")); - (1, 11, E (`Unmatched_end_tag "html")); - (1, 18, S (`Text [ "foo" ])); - (1, 21, S `End_element); - ] ); - ( "html.parser.nested-button" >:: fun _ -> - expect ~context:None "<button><button>submit</button></button>" - [ - (1, 1, S (start_element "button")); - (1, 9, E (`Misnested_tag ("button", "button", []))); - (1, 9, S `End_element); - (1, 9, S (start_element "button")); - (1, 17, S (`Text [ "submit" ])); - (1, 23, S `End_element); - (1, 32, E (`Unmatched_end_tag "button")); - ] ); - ( "html.parser.nested-list" >:: fun _ -> - expect ~context:None "<ul><li><ul></li></ul></li></ul>" - [ - (1, 1, S (start_element "ul")); - (1, 5, S (start_element "li")); - (1, 9, S (start_element "ul")); - (1, 13, E (`Unmatched_end_tag "li")); - (1, 18, S `End_element); - (1, 23, S `End_element); - (1, 28, S `End_element); - ] ); - ( "html.parser.definitions" >:: fun _ -> - expect ~context:None "</dd><dd></dd>" - [ - (1, 1, E (`Unmatched_end_tag "dd")); - (1, 6, S (start_element "dd")); - (1, 10, S `End_element); - ] ); - ( "html.parser.nested-achor" >:: fun _ -> - expect ~context:None "<a><a></a></a>" - [ - (1, 4, E (`Misnested_tag ("a", "a", []))); - (1, 11, E (`Unmatched_end_tag "a")); - (1, 1, S (start_element "a")); - (1, 4, S `End_element); - (1, 4, S (start_element "a")); - (1, 7, S `End_element); - ] ); - ( "html.parser.nested-anchor.reconstruct" >:: fun _ -> - expect ~context:None "<p><a>foo<a>bar<p>baz" - [ - (1, 1, S (start_element "p")); - (1, 10, E (`Misnested_tag ("a", "a", []))); - (1, 10, E (`Unmatched_start_tag "a")); - (1, 4, S (start_element "a")); - (1, 7, S (`Text [ "foo" ])); - (1, 10, S `End_element); - (1, 10, S (start_element "a")); - (1, 13, S (`Text [ "bar" ])); - (1, 16, S `End_element); - (1, 16, S `End_element); - (1, 16, S (start_element "p")); - (1, 10, E (`Unmatched_start_tag "a")); - (1, 10, S (start_element "a")); - (1, 19, S (`Text [ "baz" ])); - (1, 22, S `End_element); - (1, 22, S `End_element); - ] ); - ( "html.parser.nested-nobr" >:: fun _ -> - expect ~context:None "foo<nobr>bar<nobr>baz</nobr>quux</nobr>blah" - [ - (1, 13, E (`Misnested_tag ("nobr", "nobr", []))); - (1, 33, E (`Unmatched_end_tag "nobr")); - (1, 1, S (`Text [ "foo" ])); - (1, 4, S (start_element "nobr")); - (1, 10, S (`Text [ "bar" ])); - (1, 13, S `End_element); - (1, 13, S (start_element "nobr")); - (1, 19, S (`Text [ "baz" ])); - (1, 22, S `End_element); - (1, 29, S (`Text [ "quux"; "blah" ])); - ] ); - ( "html.parser.end-br" >:: fun _ -> - expect ~context:None "<br></br>" - [ - (1, 1, S (start_element "br")); - (1, 1, S `End_element); - (1, 5, E (`Unmatched_end_tag "br")); - (1, 5, S (start_element "br")); - (1, 5, S `End_element); - ] ); - ( "html.parser.hr" >:: fun _ -> - expect ~context:None "<p><hr>" - [ - (1, 1, S (start_element "p")); - (1, 4, S `End_element); - (1, 4, S (start_element "hr")); - (1, 4, S `End_element); - ] ); - ( "html.parser.input" >:: fun _ -> - expect ~context:None "<input type='text'>" - [ - ( 1, - 1, - S (`Start_element ((html_ns, "input"), [ (("", "type"), "text") ])) - ); - (1, 1, S `End_element); - ] ); - ( "html.parser.iframe" >:: fun _ -> - expect ~context:None "<iframe><p>foo&amp;</p></iframe>" - [ - (1, 1, S (start_element "iframe")); - (1, 9, S (`Text [ "<p>foo&amp;</p>" ])); - (1, 24, S `End_element); - ] ); - ( "html.parser.noembed" >:: fun _ -> - expect ~context:None "<noembed><p>foo&amp;</p></noembed>" - [ - (1, 1, S (start_element "noembed")); - (1, 10, S (`Text [ "<p>foo&amp;</p>" ])); - (1, 25, S `End_element); - ] ); - ( "html.parser.generic-tag" >:: fun _ -> - expect ~context:None "<foo></foo>" - [ (1, 1, S (start_element "foo")); (1, 6, S `End_element) ] ); - ( "html.parser.option.body" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<option><optgroup></optgroup>" - [ - (1, 1, S (start_element "option")); - (1, 9, S `End_element); - (1, 9, S (start_element "optgroup")); - (1, 19, S `End_element); - ] ); - ( "html.parser.table-content-in-body" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<caption><col><colgroup><tbody><td><tfoot><th><thead><tr>" - [ - (1, 1, E (`Misnested_tag ("caption", "body", []))); - (1, 10, E (`Misnested_tag ("col", "body", []))); - (1, 15, E (`Misnested_tag ("colgroup", "body", []))); - (1, 25, E (`Misnested_tag ("tbody", "body", []))); - (1, 32, E (`Misnested_tag ("td", "body", []))); - (1, 36, E (`Misnested_tag ("tfoot", "body", []))); - (1, 43, E (`Misnested_tag ("th", "body", []))); - (1, 47, E (`Misnested_tag ("thead", "body", []))); - (1, 54, E (`Misnested_tag ("tr", "body", []))); - ] ); - ( "html.parser.caption" >:: fun _ -> - expect ~context:None "<table><caption>foo<p>bar</caption></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "caption")); - (1, 17, S (`Text [ "foo" ])); - (1, 20, S (start_element "p")); - (1, 23, S (`Text [ "bar" ])); - (1, 26, S `End_element); - (1, 26, S `End_element); - (1, 36, S `End_element); - ] ); - ( "html.parser.colgroup" >:: fun _ -> - expect ~context:None "<table><colgroup><col></colgroup></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "colgroup")); - (1, 18, S (start_element "col")); - (1, 18, S `End_element); - (1, 23, S `End_element); - (1, 34, S `End_element); - ] ); - ( "html.parser.colgroup.implicit" >:: fun _ -> - expect ~context:None "<table><col></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "colgroup")); - (1, 8, S (start_element "col")); - (1, 8, S `End_element); - (1, 13, S `End_element); - (1, 13, S `End_element); - ] ); - ( "html.parser.td.direct" >:: fun _ -> - expect ~context:None "<table><td></td></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "tbody")); - (1, 8, E (`Misnested_tag ("td", "table", []))); - (1, 8, S (start_element "tr")); - (1, 8, S (start_element "td")); - (1, 12, S `End_element); - (1, 17, S `End_element); - (1, 17, S `End_element); - (1, 17, S `End_element); - ] ); - ( "html.parser.tbody" >:: fun _ -> - expect ~context:None "<table><tbody></tbody></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "tbody")); - (1, 15, S `End_element); - (1, 23, S `End_element); - ] ); - ( "html.parser.nested-table" >:: fun _ -> - expect ~context:None "<table><table></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, E (`Misnested_tag ("table", "table", []))); - (1, 8, S `End_element); - (1, 8, S (start_element "table")); - (1, 15, S `End_element); - ] ); - ( "html.parser.nested-caption" >:: fun _ -> - expect ~context:None "<table><caption><caption></caption></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "caption")); - (1, 17, E (`Misnested_tag ("caption", "caption", []))); - (1, 17, S `End_element); - (1, 17, S (start_element "caption")); - (1, 26, S `End_element); - (1, 36, S `End_element); - ] ); - ( "html.parser.truncated-caption" >:: fun _ -> - expect ~context:None "<table><caption></table>" - [ - (1, 1, S (start_element "table")); - (1, 8, S (start_element "caption")); - (1, 17, E (`Unmatched_end_tag "table")); - (1, 17, S `End_element); - (1, 17, S `End_element); - ] ); - ( "html.parser.nested-tbody" >:: fun _ -> - expect ~context:None "<tbody><tbody></tbody>" - [ - (1, 1, S (start_element "tbody")); - (1, 8, S `End_element); - (1, 8, S (start_element "tbody")); - (1, 15, S `End_element); - ] ); - ( "html.parser.option" >:: fun _ -> - expect ~context:None "<option></option>" - [ (1, 1, S (start_element "option")); (1, 9, S `End_element) ] ); - ( "html.parser.optgroup" >:: fun _ -> - expect ~context:None - "<select><optgroup><option><optgroup><option></optgroup></select>" - [ - (1, 1, S (start_element "select")); - (1, 9, S (start_element "optgroup")); - (1, 19, S (start_element "option")); - (1, 27, S `End_element); - (1, 27, S `End_element); - (1, 27, S (start_element "optgroup")); - (1, 37, S (start_element "option")); - (1, 45, S `End_element); - (1, 45, S `End_element); - (1, 56, S `End_element); - ] ); - ( "html.parser.form" >:: fun _ -> - expect ~context:None "<form></form>" - [ (1, 1, S (start_element "form")); (1, 7, S `End_element) ] ); - ( "html.parser.form.nested" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<form><form></form>" - [ - (1, 1, S (start_element "form")); - (1, 7, E (`Misnested_tag ("form", "form", []))); - (1, 13, S `End_element); - ] ); - ( "html.parser.form.unopened" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "</form>" - [ (1, 1, E (`Unmatched_end_tag "form")) ] ); - ( "html.parser.noframes" >:: fun _ -> - expect ~context:None "<noframes>foo&amp;bar</a></noframes>" - [ - (1, 1, S (start_element "noframes")); - (1, 11, S (`Text [ "foo&amp;bar</a>" ])); - (1, 26, S `End_element); - ] ); - ( "html.parser.frameset" >:: fun _ -> - expect "<frameset><frame></frameset>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "frameset")); - (1, 11, S (start_element "frame")); - (1, 11, S `End_element); - (1, 18, S `End_element); - (1, 29, S `End_element); - ] ); - ( "html.parser.frameset.fragment" >:: fun _ -> - expect ~context:None "<frameset></frameset>" - [ (1, 1, S (start_element "frameset")); (1, 11, S `End_element) ]; - - expect ~context:None "<frame>" - [ (1, 1, S (start_element "frame")); (1, 1, S `End_element) ] ); - ( "html.parser.frameset.content" >:: fun _ -> - expect ~context:None - ("<frameset> \t\n<!--foo--><noframes></noframes><frameset></frameset>" - ^ "</frameset>") - [ - (1, 1, S (start_element "frameset")); - (1, 11, S (`Text [ " \t\n" ])); - (2, 1, S (`Comment "foo")); - (2, 11, S (start_element "noframes")); - (2, 21, S `End_element); - (2, 32, S (start_element "frameset")); - (2, 42, S `End_element); - (2, 53, S `End_element); - ] ); - ( "html.parser.frameset.bad" >:: fun _ -> - expect ~context:None "<frameset><!DOCTYPE html><html>f" - [ - (1, 1, S (start_element "frameset")); - (1, 11, E (`Bad_document "doctype should be first")); - (1, 26, E (`Misnested_tag ("html", "frameset", []))); - (1, 32, E (`Bad_content "frameset")); - (1, 33, E (`Unexpected_eoi "frameset")); - (1, 33, S `End_element); - ] ); - ( "html.parser.after-frameset.content" >:: fun _ -> - expect ~context:None - "<frameset></frameset> \t\n<!--foo--><noframes></noframes></html>" - [ - (1, 1, S (start_element "frameset")); - (1, 11, S `End_element); - (1, 22, S (`Text [ " \t\n" ])); - (2, 1, S (`Comment "foo")); - (2, 11, S (start_element "noframes")); - (2, 21, S `End_element); - ] ); - ( "html.parser.after-frameset.bad" >:: fun _ -> - expect ~context:None "<frameset></frameset><!DOCTYPE html><html>f" - [ - (1, 1, S (start_element "frameset")); - (1, 11, S `End_element); - (1, 22, E (`Bad_document "doctype should be first")); - (1, 37, E (`Misnested_tag ("html", "html", []))); - (1, 43, E (`Bad_content "html")); - ] ); - ( "html.parser.frameset-in-body" >:: fun _ -> - expect - ~context:(Some (`Fragment "body")) - "<frameset><p>" - [ - (1, 1, E (`Misnested_tag ("frameset", "body", []))); - (1, 11, S (start_element "p")); - (1, 14, S `End_element); - ]; - - expect ~context:None "<body><p><frameset><p></body>" - [ - (1, 1, S (start_element "body")); - (1, 7, S (start_element "p")); - (1, 10, E (`Misnested_tag ("frameset", "body", []))); - (1, 20, S `End_element); - (1, 20, S (start_element "p")); - (1, 30, S `End_element); - (1, 30, S `End_element); - ]; - - expect ~context:None "<p><frameset><p>" - [ - (1, 1, S (start_element "p")); - (1, 4, E (`Misnested_tag ("frameset", "body", []))); - (1, 14, S `End_element); - (1, 14, S (start_element "p")); - (1, 17, S `End_element); - ]; - - expect "<p><frameset><frame></frameset>" - [ - (1, 1, S (start_element "html")); - (1, 1, S (start_element "head")); - (1, 1, S `End_element); - (1, 1, S (start_element "body")); - (1, 1, S (start_element "p")); - (1, 4, E (`Misnested_tag ("frameset", "body", []))); - (1, 4, S `End_element); - (1, 4, S `End_element); - (1, 4, S (start_element "frameset")); - (1, 14, S (start_element "frame")); - (1, 14, S `End_element); - (1, 21, S `End_element); - (1, 32, S `End_element); - ] ); - ] From cac28c32760fc868ca2523b99e126ce1b09cf9d0 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Tue, 1 Sep 2026 12:05:09 -0400 Subject: [PATCH 101/109] perf: reset mark to allow fast path to run again --- src/lite/ragel_html_tokenizer.ml | 6 ++++++ src/lite/ragel_html_tokenizer.ml.rl | 6 ++++++ 2 files changed, 12 insertions(+) diff --git a/src/lite/ragel_html_tokenizer.ml b/src/lite/ragel_html_tokenizer.ml index 4d63cae..ed7d4f9 100644 --- a/src/lite/ragel_html_tokenizer.ml +++ b/src/lite/ragel_html_tokenizer.ml @@ -659,6 +659,8 @@ let run scanner foreign = done; p := next; cs := htmlstream_en_main; + (* clear so [scan_data_text] has a chance to fire again *) + mark := -1; if !p >= !eof then scanner.finished <- true end else if scanner.end_scan >= 0 then begin @@ -675,6 +677,7 @@ let run scanner foreign = done; p := next; cs := htmlstream_en_main; + mark := -1; if !p >= !eof then scanner.finished <- true end else if scanner.bogus >= 0 then begin @@ -695,6 +698,7 @@ let run scanner foreign = done; p := result.Markup_declaration.next; cs := htmlstream_en_main; + mark := -1; if !p >= !eof then scanner.finished <- true end else if scanner.declaration >= 0 then begin @@ -722,6 +726,7 @@ let run scanner foreign = end; p := result.Markup_declaration.next; cs := htmlstream_en_main; + mark := -1; if !p >= !eof then scanner.finished <- true end else if scan_data_text scanner then () @@ -985,6 +990,7 @@ let scan_raw_state scanner state drop_candidate = done; scanner.p := next_index; scanner.cs := htmlstream_en_main; + scanner.mark := -1; if next_index >= !(scanner.eof) then scanner.finished <- true end diff --git a/src/lite/ragel_html_tokenizer.ml.rl b/src/lite/ragel_html_tokenizer.ml.rl index 38eb4dc..0cbc7dd 100644 --- a/src/lite/ragel_html_tokenizer.ml.rl +++ b/src/lite/ragel_html_tokenizer.ml.rl @@ -233,6 +233,8 @@ let run scanner foreign = done; p := next; cs := htmlstream_en_main; + (* clear so [scan_data_text] has a chance to fire again *) + mark := -1; if !p >= !eof then scanner.finished <- true end else if scanner.end_scan >= 0 then begin @@ -250,6 +252,7 @@ let run scanner foreign = done; p := next; cs := htmlstream_en_main; + mark := -1; if !p >= !eof then scanner.finished <- true end else if scanner.bogus >= 0 then begin @@ -270,6 +273,7 @@ let run scanner foreign = done; p := result.Markup_declaration.next; cs := htmlstream_en_main; + mark := -1; if !p >= !eof then scanner.finished <- true end else if scanner.declaration >= 0 then begin @@ -297,6 +301,7 @@ let run scanner foreign = end; p := result.Markup_declaration.next; cs := htmlstream_en_main; + mark := -1; if !p >= !eof then scanner.finished <- true end else if scan_data_text scanner then () @@ -351,6 +356,7 @@ let scan_raw_state scanner state drop_candidate = done; scanner.p := next_index; scanner.cs := htmlstream_en_main; + scanner.mark := -1; if next_index >= !(scanner.eof) then scanner.finished <- true end From 8f8de5d861b480b5390a923f39b66cb98a3229ed Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Tue, 1 Sep 2026 12:27:26 -0400 Subject: [PATCH 102/109] support BOM-detected UTF-16 in lite just translate utf16 to utf8 on the fly. --- src/lite/encoding.ml | 54 ++++++++++++++++++++++----- src/lite/markup_lite.ml | 4 +- src/lite/markup_lite.mli | 2 +- test/lite/lite_baseline_regression.ml | 16 ++++++-- 4 files changed, 61 insertions(+), 15 deletions(-) diff --git a/src/lite/encoding.ml b/src/lite/encoding.ml index c0f4bc6..ca260ab 100644 --- a/src/lite/encoding.ml +++ b/src/lite/encoding.ml @@ -174,14 +174,48 @@ let windows_1251 input = else 0x0410 + byte - 0xC0) input -let decode_html input = - if String.length input >= 3 && String.sub input 0 3 = "\xEF\xBB\xBF" then +let transcode_utf_16 fold input = + let output = Buffer.create (String.length input) in + fold + (fun () _ -> function + | `Uchar uchar -> Uutf.Buffer.add_utf_8 output uchar + | `Malformed _ -> Uutf.Buffer.add_utf_8 output Uutf.u_rep) + () input; + Buffer.contents output + +let utf_16be input = + transcode_utf_16 + (fun folder state input -> Uutf.String.fold_utf_16be folder state input) + input + +let utf_16le input = + transcode_utf_16 + (fun folder state input -> Uutf.String.fold_utf_16le folder state input) input - else - match declared_encoding input with - | Some ("windows-1251" | "cp1251" | "x-cp1251") -> windows_1251 input - | Some - ( "windows-1252" | "cp1252" | "x-cp1252" | "iso-8859-1" | "latin1" - | "us-ascii" | "ascii" ) -> - windows_1252 input - | _ -> input + +let bom input = + let length = String.length input in + if length >= 2 && input.[0] = '\xFE' && input.[1] = '\xFF' then Some `UTF_16BE + else if length >= 2 && input.[0] = '\xFF' && input.[1] = '\xFE' then + Some `UTF_16LE + else if + length >= 3 + && input.[0] = '\xEF' + && input.[1] = '\xBB' + && input.[2] = '\xBF' + then Some `UTF_8 + else None + +let decode_html input = + match bom input with + | Some `UTF_16BE -> utf_16be input + | Some `UTF_16LE -> utf_16le input + | Some `UTF_8 -> input + | None -> ( + match declared_encoding input with + | Some ("windows-1251" | "cp1251" | "x-cp1251") -> windows_1251 input + | Some + ( "windows-1252" | "cp1252" | "x-cp1252" | "iso-8859-1" | "latin1" + | "us-ascii" | "ascii" ) -> + windows_1252 input + | _ -> input) diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index 47600b9..7c6b6ad 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -22,7 +22,7 @@ type doctype = Markup_common.doctype = { } type signal = Markup_common.signal -type encoding = [ `Auto | `UTF_8 ] +type encoding = [ `Auto | `UTF_8 | `UTF_16BE | `UTF_16LE ] module Token_tag = Common.Token_tag @@ -58,6 +58,8 @@ let parse_html ?(report = fun _ _ -> ()) ?(encoding = `Auto) match encoding with | `Auto -> Token_source.create html | `UTF_8 -> Token_source.create_utf_8 html + | `UTF_16BE -> Encoding.utf_16be html |> Token_source.create_utf_8 + | `UTF_16LE -> Encoding.utf_16le html |> Token_source.create_utf_8 in parse_source report context depth_limit source diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index f15d1f1..eecd126 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -24,7 +24,7 @@ type doctype = Markup_common.doctype = { } type signal = Markup_common.signal -type encoding = [ `Auto | `UTF_8 ] +type encoding = [ `Auto | `UTF_8 | `UTF_16BE | `UTF_16LE ] module Token_tag : sig type t = { diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index b4e98c9..c087a06 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -29,19 +29,22 @@ let agrees ?(context = `Document) name html = assert_equal ~printer:print_signals (baseline context html) (lite context html) -let agrees_utf_8 name html = +let agrees_encoding name baseline_encoding lite_encoding html = name >:: fun _ -> let expected = Markup.string html - |> Markup.parse_html ~encoding:Markup.Encoding.utf_8 ~context:`Document + |> Markup.parse_html ~encoding:baseline_encoding ~context:`Document |> Markup.signals |> Markup.to_list in let actual = - Markup_lite.parse_html ~encoding:`UTF_8 ~context:`Document html + Markup_lite.parse_html ~encoding:lite_encoding ~context:`Document html |> collect Markup_lite.iter in assert_equal ~printer:print_signals expected actual +let agrees_utf_8 name html = + agrees_encoding name Markup.Encoding.utf_8 `UTF_8 html + let agrees_with_text ?(context = `Document) name html text = name >:: fun _ -> let expected = baseline context html in @@ -149,6 +152,13 @@ let () = agrees_with_text "internal bom is preserved" "a\xEF\xBB\xBFb" "a\xEF\xBB\xBFb"; agrees "two leading boms" "\xEF\xBB\xBF\xEF\xBB\xBFa"; + agrees "UTF-16LE bom" + "\xFF\xFE\x3C\x00\x70\x00\x3E\x00\xE9\x00\x3C\x00\x2F\x00\x70\x00\x3E\x00"; + agrees "UTF-16BE bom" + "\xFE\xFF\x00\x3C\x00\x70\x00\x3E\x00\xE9\x00\x3C\x00\x2F\x00\x70\x00\x3E"; + agrees_encoding "explicit UTF-16LE" Markup.Encoding.utf_16le + `UTF_16LE + "\x3C\x00\x70\x00\x3E\x00\x78\x00\x3C\x00\x2F\x00\x70\x00\x3E\x00"; ]; "table whitespace" >::: [ From f1d1a1919ac8cdf238dfd3ce588eea97f4e83502 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes@ahrefs.com> Date: Tue, 1 Sep 2026 12:53:43 -0400 Subject: [PATCH 103/109] fix: CI: install missing opam deps --- .github/workflows/test.yml | 6 +++--- markup.opam | 2 ++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index d653677..4cef6d2 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -12,11 +12,11 @@ jobs: - 4.14.2 steps: - - uses: actions/checkout@v2 - - uses: ocaml/setup-ocaml@v2 + - uses: actions/checkout@v4 + - uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{matrix.ocaml}} - - run: sudo apt-get install python-bs4 + - run: sudo apt-get install python3-bs4 - run: opam install --deps-only --with-test . --yes - run: opam install js_of_ocaml --yes diff --git a/markup.opam b/markup.opam index 7a153b6..dcf8236 100644 --- a/markup.opam +++ b/markup.opam @@ -18,6 +18,8 @@ depends: [ "uutf" {>= "1.0.0"} "bisect_ppx" {dev & >= "2.5.0"} + "containers" {with-test} + "devkit" {with-test} "ounit2" {dev} ] # Markup.ml implicitly requires OCaml 4.02.3, as this is a contraint of Dune. From 52250f859f770b1f5babc1aaeab7cf56bd1f669c Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes.2007@m4x.org> Date: Tue, 1 Sep 2026 21:43:03 -0400 Subject: [PATCH 104/109] better encoding detection, with BOM and meta+charset --- src/lite/encoding.ml | 390 ++++++++++++++++++++------ src/lite/encoding.mli | 8 + test/lite/lite_baseline_regression.ml | 17 ++ 3 files changed, 323 insertions(+), 92 deletions(-) create mode 100644 src/lite/encoding.mli diff --git a/src/lite/encoding.ml b/src/lite/encoding.ml index ca260ab..062e503 100644 --- a/src/lite/encoding.ml +++ b/src/lite/encoding.ml @@ -3,83 +3,307 @@ let ascii_lower = Char.lowercase_ascii let is_space = function ' ' | '\t' | '\n' | '\r' | '\x0C' -> true | _ -> false +let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false -let declared_encoding input = - let length = min 1024 (String.length input) in - let needle = "charset" in - let rec matches index offset = - offset = String.length needle - || index + offset < length - && ascii_lower input.[index + offset] = needle.[offset] - && matches index (offset + 1) +type cursor = { input : string; limit : int; mutable position : int } + +let next cursor = + assert (cursor.position < cursor.limit); + let byte = cursor.input.[cursor.position] in + cursor.position <- cursor.position + 1; + byte + +let skip_spaces cursor = + while + cursor.position < cursor.limit && is_space cursor.input.[cursor.position] + do + cursor.position <- cursor.position + 1 + done + +(* [text] must contain only lowercase ASCII. *) +let starts_with_ci cursor text = + let length = String.length text in + let rec matches index = + index = length + || ascii_lower cursor.input.[cursor.position + index] = text.[index] + && matches (index + 1) in - let rec skip_spaces index = - if index < length && is_space input.[index] then skip_spaces (index + 1) - else index + cursor.position + length <= cursor.limit && matches 0 + +let read_while cursor predicate = + let start = cursor.position in + while + cursor.position < cursor.limit && predicate cursor.input.[cursor.position] + do + cursor.position <- cursor.position + 1 + done; + String.sub cursor.input start (cursor.position - start) + +let read_quoted_value cursor quote = + let start = cursor.position in + while + cursor.position < cursor.limit && cursor.input.[cursor.position] <> quote + do + cursor.position <- cursor.position + 1 + done; + if cursor.position >= cursor.limit then "" + else + let value = String.sub cursor.input start (cursor.position - start) in + cursor.position <- cursor.position + 1; + String.lowercase_ascii value + +let read_unquoted_value cursor terminator = + read_while cursor (fun byte -> not (is_space byte || byte = terminator)) + |> String.lowercase_ascii + +let read_value cursor = + skip_spaces cursor; + match next cursor with + | ('\'' | '"') as quote -> read_quoted_value cursor quote + | _ -> + cursor.position <- cursor.position - 1; + read_unquoted_value cursor '>' + +let read_attribute_name cursor = + let start = cursor.position in + while + cursor.position < cursor.limit + && + let byte = cursor.input.[cursor.position] in + not + (is_space byte || byte = '/' || byte = '>' + || (byte = '=' && cursor.position > start)) + do + cursor.position <- cursor.position + 1 + done; + String.sub cursor.input start (cursor.position - start) + |> String.lowercase_ascii + +let read_attribute cursor = + skip_spaces cursor; + while + cursor.position < cursor.limit && cursor.input.[cursor.position] = '/' + do + cursor.position <- cursor.position + 1; + skip_spaces cursor + done; + if cursor.position >= cursor.limit || cursor.input.[cursor.position] = '>' + then None + else + let name = read_attribute_name cursor in + skip_spaces cursor; + let value = + if cursor.position < cursor.limit && cursor.input.[cursor.position] = '=' + then begin + cursor.position <- cursor.position + 1; + if cursor.position < cursor.limit then read_value cursor else "" + end + else "" + in + Some (name, value) + +let extract_encoding value : string option = + let cursor = { input = value; limit = String.length value; position = 0 } in + let rec search () = + if cursor.position >= cursor.limit then None + else if starts_with_ci cursor "charset" then begin + cursor.position <- cursor.position + 7; + skip_spaces cursor; + if cursor.position >= cursor.limit then None + else if next cursor <> '=' then begin + cursor.position <- cursor.position - 1; + search () + end + else begin + skip_spaces cursor; + if cursor.position >= cursor.limit then None + else + let value = + match next cursor with + | ('\'' | '"') as quote -> read_quoted_value cursor quote + | _ -> + cursor.position <- cursor.position - 1; + read_unquoted_value cursor ';' + in + if value = "" then search () else Some value + end + end + else begin + cursor.position <- cursor.position + 1; + search () + end in - let rec value_end index = - if index < length then - match input.[index] with - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' -> value_end (index + 1) - | _ -> index - else index + search () + +let normalize_declared_encoding value = + match String.lowercase_ascii (Common.trim_string value) with + | "unicode-1-1-utf-8" | "utf-8" | "utf8" -> "utf-8" + | "utf-16" | "utf-16be" | "utf-16le" -> "utf-8" + | "cp1251" | "windows-1251" | "x-cp1251" -> "windows-1251" + | "ansi_x3.4-1968" | "ascii" | "cp1252" | "cp819" | "csisolatin1" | "ibm819" + | "iso-8859-1" | "iso-ir-100" | "iso8859-1" | "iso88591" | "iso_8859-1" + | "iso_8859-1:1987" | "l1" | "latin1" | "us-ascii" | "windows-1252" + | "x-cp1252" -> + "windows-1252" + | value -> value + +(** Parse encoding inside a [meta] tag *) +let read_meta_encoding cursor = + let rec attributes names got_pragma need_pragma charset = + match read_attribute cursor with + | None -> + if need_pragma = Some true && not got_pragma then None + else Option.map normalize_declared_encoding charset + | Some (name, _) when Common.list_mem_string name names -> + attributes names got_pragma need_pragma charset + | Some (name, value) -> + let names = name :: names in + begin match name with + | "http-equiv" -> + attributes names + (got_pragma || value = "content-type") + need_pragma charset + | "content" when charset = None -> + begin match extract_encoding value with + | Some value -> attributes names got_pragma (Some true) (Some value) + | None -> attributes names got_pragma need_pragma charset + end + | "charset" when value <> "" -> + attributes names got_pragma (Some false) (Some value) + | _ -> attributes names got_pragma need_pragma charset + end in - let rec search index = - if index + String.length needle > length then None - else if not (matches index 0) then search (index + 1) - else - let after_name = skip_spaces (index + String.length needle) in - if after_name >= length || input.[after_name] <> '=' then - search (index + 1) - else - let start = skip_spaces (after_name + 1) in - let start = - if start < length && (input.[start] = '\'' || input.[start] = '"') - then start + 1 - else start - in - let stop = value_end start in - if stop = start then search (index + 1) - else - Some (String.sub input start (stop - start) |> String.lowercase_ascii) + attributes [] false None None + +let skip_tag_like cursor = + while cursor.position < cursor.limit && next cursor <> '>' do + () + done + +let skip_tag cursor = + while + cursor.position < cursor.limit + && (not (is_space cursor.input.[cursor.position])) + && cursor.input.[cursor.position] <> '>' + do + cursor.position <- cursor.position + 1 + done; + while cursor.position < cursor.limit && read_attribute cursor <> None do + () + done; + if cursor.position < cursor.limit then cursor.position <- cursor.position + 1 + +let skip_comment cursor = + while + cursor.position + 2 < cursor.limit + && (cursor.input.[cursor.position] <> '-' + || cursor.input.[cursor.position + 1] <> '-' + || cursor.input.[cursor.position + 2] <> '>') + do + cursor.position <- cursor.position + 1 + done; + cursor.position <- min cursor.limit (cursor.position + 3) + +let declared_encoding input : string option = + let cursor = + { input; limit = min 1024 (String.length input); position = 0 } + in + let rec scan () = + while cursor.position < cursor.limit && next cursor <> '<' do + () + done; + if cursor.position >= cursor.limit then None + else if starts_with_ci cursor "!--" then begin + cursor.position <- cursor.position + 3; + skip_comment cursor; + scan () + end + else if starts_with_ci cursor "meta" then begin + cursor.position <- cursor.position + 4; + if + cursor.position < cursor.limit + && (is_space cursor.input.[cursor.position] + || cursor.input.[cursor.position] = '/') + then ( + match read_meta_encoding cursor with + | Some _ as encoding -> encoding + | None -> + if cursor.position < cursor.limit then + cursor.position <- cursor.position + 1; + scan ()) + else begin + skip_tag cursor; + scan () + end + end + else if cursor.position < cursor.limit then begin + begin match cursor.input.[cursor.position] with + | '!' | '?' -> skip_tag_like cursor + | '/' + when cursor.position + 1 < cursor.limit + && is_letter cursor.input.[cursor.position + 1] -> + skip_tag cursor + | '/' -> skip_tag_like cursor + | byte when is_letter byte -> skip_tag cursor + | _ -> () + end; + scan () + end + else None in - search 0 + scan () -let windows_1252_high = - [| - 0x20AC; - 0x0081; - 0x201A; - 0x0192; - 0x201E; - 0x2026; - 0x2020; - 0x2021; - 0x02C6; - 0x2030; - 0x0160; - 0x2039; - 0x0152; - 0x008D; - 0x017D; - 0x008F; - 0x0090; - 0x2018; - 0x2019; - 0x201C; - 0x201D; - 0x2022; - 0x2013; - 0x2014; - 0x02DC; - 0x2122; - 0x0161; - 0x203A; - 0x0153; - 0x009D; - 0x017E; - 0x0178; - |] +let transcode scalar input = + let output = Buffer.create (String.length input + 32) in + String.iter + (fun byte -> + Uutf.Buffer.add_utf_8 output (Uchar.of_int (scalar (Char.code byte)))) + input; + Buffer.contents output + +module Windows_1252 = struct + let high = + [| + 0x20AC; + 0x0081; + 0x201A; + 0x0192; + 0x201E; + 0x2026; + 0x2020; + 0x2021; + 0x02C6; + 0x2030; + 0x0160; + 0x2039; + 0x0152; + 0x008D; + 0x017D; + 0x008F; + 0x0090; + 0x2018; + 0x2019; + 0x201C; + 0x201D; + 0x2022; + 0x2013; + 0x2014; + 0x02DC; + 0x2122; + 0x0161; + 0x203A; + 0x0153; + 0x009D; + 0x017E; + 0x0178; + |] + + let decode input = + transcode + (fun byte -> + if byte < 0x80 || byte >= 0xA0 then byte else high.(byte - 0x80)) + input +end let windows_1251_high = [| @@ -149,21 +373,6 @@ let windows_1251_high = 0x0457; |] -let transcode scalar input = - let output = Buffer.create (String.length input + 32) in - String.iter - (fun byte -> - Uutf.Buffer.add_utf_8 output (Uchar.of_int (scalar (Char.code byte)))) - input; - Buffer.contents output - -let windows_1252 input = - transcode - (fun byte -> - if byte < 0x80 || byte >= 0xA0 then byte - else windows_1252_high.(byte - 0x80)) - input - let windows_1251 input = transcode (fun byte -> @@ -206,16 +415,13 @@ let bom input = then Some `UTF_8 else None -let decode_html input = +let decode_html input : string = match bom input with | Some `UTF_16BE -> utf_16be input | Some `UTF_16LE -> utf_16le input | Some `UTF_8 -> input | None -> ( match declared_encoding input with - | Some ("windows-1251" | "cp1251" | "x-cp1251") -> windows_1251 input - | Some - ( "windows-1252" | "cp1252" | "x-cp1252" | "iso-8859-1" | "latin1" - | "us-ascii" | "ascii" ) -> - windows_1252 input + | Some "windows-1251" -> windows_1251 input + | Some "windows-1252" -> Windows_1252.decode input | _ -> input) diff --git a/src/lite/encoding.mli b/src/lite/encoding.mli new file mode 100644 index 0000000..14f3623 --- /dev/null +++ b/src/lite/encoding.mli @@ -0,0 +1,8 @@ +(* This file is part of Markup.ml, released under the MIT license. See + LICENSE.md for details, or visit https://github.com/aantron/markup.ml. *) + +val decode_html : string -> string +(** Detect encoding, and decode to utf8 if necessary *) + +val utf_16be : string -> string +val utf_16le : string -> string diff --git a/test/lite/lite_baseline_regression.ml b/test/lite/lite_baseline_regression.ml index c087a06..25a984f 100644 --- a/test/lite/lite_baseline_regression.ml +++ b/test/lite/lite_baseline_regression.ml @@ -139,6 +139,23 @@ let () = "<meta charset=windows-1251><p>\xD0"; agrees "HTML iso-8859-1 is windows-1252" "<meta charset=iso-8859-1><p>caf\xE9"; + agrees "bare charset text is ignored" + "<p>charset=windows-1252 \xC3\xA9"; + agrees "charset in a comment is ignored" + "<!-- <meta charset=windows-1252> --><p>\xC3\xA9"; + agrees "charset in a quoted attribute is ignored" + "<p title='<meta charset=windows-1252>'>\xC3\xA9"; + agrees "content pragma" + "<meta http-equiv=content-type content='text/html; \ + charset=windows-1252'><p>\xE9"; + agrees "pragma after content" + "<meta content='text/html; charset=windows-1252' \ + http-equiv=content-type><p>\xE9"; + agrees "content without pragma is ignored" + "<meta content='text/html; \ + charset=windows-1252'><p>\xC3\xA9"; + agrees "duplicate charset attribute keeps the first" + "<meta charset=windows-1251 charset=windows-1252><p>\xCF"; agrees "UTF-8 BOM takes precedence" "\xEF\xBB\xBF<meta charset=windows-1251><p>caf\xC3\xA9"; ]; From 3a79c76bd4bba0c606c7454ceff627caaeb89cdd Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes.2007@m4x.org> Date: Wed, 2 Sep 2026 08:56:06 -0400 Subject: [PATCH 105/109] add Markup_lite.to_html_string --- src/lite/markup_lite.ml | 5 +++++ src/lite/markup_lite.mli | 6 ++++++ 2 files changed, 11 insertions(+) diff --git a/src/lite/markup_lite.ml b/src/lite/markup_lite.ml index 7c6b6ad..3a82407 100644 --- a/src/lite/markup_lite.ml +++ b/src/lite/markup_lite.ml @@ -91,3 +91,8 @@ let iter f stream = let write_html ?escape_attribute ?escape_text buffer signals = Html_writer.write ?escape_attribute ?escape_text buffer signals + +let to_html_string ?escape_attribute ?escape_text signals = + let buffer = Buffer.create 512 in + write_html ?escape_attribute ?escape_text buffer signals; + Buffer.contents buffer diff --git a/src/lite/markup_lite.mli b/src/lite/markup_lite.mli index eecd126..cc54ed6 100644 --- a/src/lite/markup_lite.mli +++ b/src/lite/markup_lite.mli @@ -71,3 +71,9 @@ val write_html : Buffer.t -> (signal, sync) stream -> unit + +val to_html_string : + ?escape_attribute:(Buffer.t -> string -> unit) -> + ?escape_text:(Buffer.t -> string -> unit) -> + (signal, sync) stream -> + string From 0f15523fd2eb5f492f4b4583b64fe97ba157dbd4 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes.2007@m4x.org> Date: Wed, 2 Sep 2026 16:25:24 -0400 Subject: [PATCH 106/109] fix handling of empty lines --- src/lite/html_parser.ml | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index 178e1e4..ee9b414 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -1739,9 +1739,13 @@ let parse ?depth_limit requested_context report tokens = match next_token tokens with | _, Char 0x000A -> mode () | loc, String s when String.starts_with ~prefix:"\n" s -> - push tokens - (loc, String (String.sub s 1 (String.length s - 1))); - mode () + if String.length s = 1 then + reconstruct_active_formatting_elements mode + else begin + let rest = String.sub s 1 (String.length s - 1) in + push tokens (loc, String rest); + mode () + end | v -> push tokens v; mode () From 39ed8a2262f07cc2a9dc3e62261f4fe551761627 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes.2007@m4x.org> Date: Wed, 2 Sep 2026 16:25:39 -0400 Subject: [PATCH 107/109] more regression tests found by shadowing in prod --- test/lite/dune | 10 ++++++ test/lite/lite_mismatch_regression.ml | 50 +++++++++++++++++++++++++++ 2 files changed, 60 insertions(+) create mode 100644 test/lite/lite_mismatch_regression.ml diff --git a/test/lite/dune b/test/lite/dune index a4905b0..290c636 100644 --- a/test/lite/dune +++ b/test/lite/dune @@ -44,6 +44,11 @@ (modules lite_fuzz_regression) (libraries lite_test_oracle markup markup.common markup.lite ounit2)) +(executable + (name lite_mismatch_regression) + (modules lite_mismatch_regression) + (libraries lite_test_oracle markup markup.common markup.lite ounit2)) + (rule (alias runtest) (action @@ -54,6 +59,11 @@ (action (run %{exe:lite_fuzz_regression.exe}))) +(rule + (alias runtest) + (action + (run %{exe:lite_mismatch_regression.exe}))) + (rule (alias runtest) (action diff --git a/test/lite/lite_mismatch_regression.ml b/test/lite/lite_mismatch_regression.ml new file mode 100644 index 0000000..5565467 --- /dev/null +++ b/test/lite/lite_mismatch_regression.ml @@ -0,0 +1,50 @@ +(* Representative non-NUL mismatch families from some production mismatches. + The production path first adapts HtmlStream tokens, so these tests use the + same adapter rather than parsing independently tokenized HTML. *) + +open OUnit2 + +let collect iter stream = + let signals = ref [] in + iter (fun signal -> signals := signal :: !signals) stream; + List.rev !signals + +let baseline html = + let tokens = Oracle.adapt html in + collect Markup.iter + (Oracle.parse_adapted ~context:`Document (fun _ _ -> ()) tokens) + +let lite html = + let tokens = Oracle.adapt html in + collect Markup_lite.iter + (Oracle.parse_lite_adapted ~context:`Document (fun _ _ -> ()) tokens) + +let print_signals signals = + signals + |> List.map Markup_common.signal_to_string + |> String.concat "\n " |> Printf.sprintf "\n %s" + +let agrees name html = + name >:: fun _ -> + assert_equal ~printer:print_signals (baseline html) (lite html) + +let () = + run_test_tt_main + ("production mismatch regressions" + >::: [ + (* Representative of the first-diff-965 gachon.ac.kr pages. *) + agrees "paragraph reconstruction across an active anchor" + "<p><a href='https://example.test/'>one<p>two"; + (* Representative of the first-diff-884/885 gachon.ac.kr pages. *) + agrees "nested bold reconstruction across a block" + "<div><b><b><div>text"; + (* Representative of the first-diff-992/998 toyless pages. *) + agrees "font reconstruction inside a nested div" + "<div class='options'><font color='#138f9a'><div id='option'>text"; + (* Minimized from http://koganeijinja.com/: the trailing newline is + required. HtmlStream presents it as a String token. *) + agrees "formatting reconstruction after stripped pre newline" + "<p><font><pre>\n"; + agrees "formatting reconstruction after stripped listing newline" + "<p><font><listing>\n"; + ]) From a8ffdffbe94e76bc6f7d536e857858feace4b373 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes.2007@m4x.org> Date: Thu, 3 Sep 2026 14:57:10 -0400 Subject: [PATCH 108/109] fix a diff between baseline and lite --- src/lite/html_parser.ml | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/src/lite/html_parser.ml b/src/lite/html_parser.ml index ee9b414..d8b0295 100644 --- a/src/lite/html_parser.ml +++ b/src/lite/html_parser.ml @@ -1585,12 +1585,12 @@ let parse ?depth_limit requested_context report tokens = and in_body_mode_rules context_name mode = function | l, Char 0 -> report l (`Bad_token ("U+0000", "body", "null")) !throw mode | l, String s -> - let s = remove_nulls s in - if s = "" then mode () + let text = remove_nulls s in + if text = "" && s <> "" then mode () else reconstruct_active_formatting_elements (fun () -> - add_string l s; - if not @@ is_whitespace_only s then frameset_ok := false; + add_string l text; + if not @@ is_whitespace_only text then frameset_ok := false; mode ()) | l, Char ((0x0009 | 0x000A | 0x000C | 0x000D | 0x0020) as c) -> reconstruct_active_formatting_elements (fun () -> @@ -1739,13 +1739,9 @@ let parse ?depth_limit requested_context report tokens = match next_token tokens with | _, Char 0x000A -> mode () | loc, String s when String.starts_with ~prefix:"\n" s -> - if String.length s = 1 then - reconstruct_active_formatting_elements mode - else begin - let rest = String.sub s 1 (String.length s - 1) in - push tokens (loc, String rest); - mode () - end + push tokens + (loc, String (String.sub s 1 (String.length s - 1))); + mode () | v -> push tokens v; mode () From 584d967101a9c57635a496a0c6f72efb9ae11066 Mon Sep 17 00:00:00 2001 From: Simon Cruanes <simon.cruanes.2007@m4x.org> Date: Thu, 3 Sep 2026 14:57:20 -0400 Subject: [PATCH 109/109] regression tests for fuzzer-found differences --- test/lite/lite_fuzz_regression.ml | 52 +++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/test/lite/lite_fuzz_regression.ml b/test/lite/lite_fuzz_regression.ml index caab3be..f19667b 100644 --- a/test/lite/lite_fuzz_regression.ml +++ b/test/lite/lite_fuzz_regression.ml @@ -36,6 +36,39 @@ let adapted_agrees name html = name >:: fun _ -> assert_equal ~printer:print_signals (adapted_oracle html) (adapted_lite html) +(* [adapted_agrees] compares signals only. These two also need the error + stream: the 2026-09-03 divergences below were error-only or error-visible. *) +let adapted_outcome parse html = + let tokens = Oracle.adapt html in + let errors = ref [] in + let report location error = errors := (location, error) :: !errors in + let signals = parse report tokens in + ( List.map Markup_common.signal_to_string signals, + List.rev_map + (fun ((line, column), error) -> + Printf.sprintf "(%d,%d) %s" line column + (Markup_common.Error.to_string error)) + !errors ) + +let adapted_oracle_outcome = + adapted_outcome (fun report tokens -> + collect Markup.iter + (Oracle.parse_adapted ~context:`Document report tokens)) + +let adapted_lite_outcome = + adapted_outcome (fun report tokens -> + collect Markup_lite.iter + (Oracle.parse_lite_adapted ~context:`Document report tokens)) + +let print_outcome (signals, errors) = + Printf.sprintf "\n %s" (String.concat "\n " (signals @ errors)) + +let adapted_agrees_with_errors name html = + name >:: fun _ -> + assert_equal ~printer:print_outcome + (adapted_oracle_outcome html) + (adapted_lite_outcome html) + let lite_parses name html = name >:: fun _ -> ignore (lite html) let rawtext_failures = @@ -133,6 +166,24 @@ let doctype_lookahead_guards = ] |> List.map (fun (name, html) -> agrees name html) +let pre_newline_pushback = + [ + (* [<a;>] produces no token of its own; it only splits the character run + into [String "a\n"; String "\n"]. Lite used to consume the second token + inside the [pre] handler and drop it, keeping one newline the oracle + dropped. Needs pre/listing + an open formatting element + foreign + content: the formatting element keeps the subtree buffer on, so + [current_mode] stays pinned to the [pre] continuation and every character + of foreign text re-enters it. *) + adapted_agrees_with_errors + "split foreign text run under pre and a formatting element" + "<pre><a><svg>a\n<a;>\n"; + (* Error-stream only. The empty remainder has to be re-dispatched so that + "in table" reports a second [bad content in 'table']. *) + adapted_agrees_with_errors + "pre as a direct table child with a leading newline" "<table><pre>\n"; + ] + let () = run_test_tt_main ("Lite fuzz regressions" @@ -146,4 +197,5 @@ let () = "doctype lookahead guards" >::: doctype_lookahead_guards; "end-tag candidate recovery" >::: candidate_recovery_failures; "end-tag candidate guards" >::: candidate_recovery_guards; + "pre newline push-back" >::: pre_newline_pushback; ])