diff --git a/CHANGES.md b/CHANGES.md index c735da8..d290133 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,8 @@ Unreleased - h2: drop the dependency on `httpaf`, use [`httpun-types`](https://ocaml.org/p/httpun-types/latest) instead ([#243](https://github.com/anmonteiro/ocaml-h2/pull/243)) +- hpack: use `String.unsafe_get` when the string length is known + ([#244](https://github.com/anmonteiro/ocaml-h2/pull/244)) 0.11.0 2023-10-26 -------------- diff --git a/hpack/src/static_table.ml b/hpack/src/static_table.ml index 02ca32c..a3fc68d 100644 --- a/hpack/src/static_table.ml +++ b/hpack/src/static_table.ml @@ -156,12 +156,12 @@ let table = let lookup_token_index name = match String.length name with | 3 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'a' when name = "age" -> 20 | 'v' when name = "via" -> 59 | _ -> -1) | 4 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'd' when name = "date" -> 32 | 'e' when name = "etag" -> 33 | 'f' when name = "from" -> 36 @@ -170,13 +170,13 @@ let lookup_token_index name = | 'v' when name = "vary" -> 58 | _ -> -1) | 5 -> - (match name.[0] with + (match String.unsafe_get name 0 with | ':' when name = ":path" -> 3 | 'a' when name = "allow" -> 21 | 'r' when name = "range" -> 49 | _ -> -1) | 6 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'a' when name = "accept" -> 18 | 'c' when name = "cookie" -> 31 | 'e' when name = "expect" -> 34 @@ -198,14 +198,17 @@ let lookup_token_index name = | 'a' when name = "location" -> 45 | _ -> -1) | 10 -> - (match name.[0] with + (match String.unsafe_get name 0 with | ':' when name = ":authority" -> 0 | 's' when name = "set-cookie" -> 54 | 'u' when name = "user-agent" -> 57 | _ -> -1) - | 11 -> (match name.[0] with 'r' when name = "retry-after" -> 52 | _ -> -1) + | 11 -> + (match String.unsafe_get name 0 with + | 'r' when name = "retry-after" -> 52 + | _ -> -1) | 12 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'c' when name = "content-type" -> 30 | 'm' when name = "max-forwards" -> 46 | _ -> -1) @@ -219,7 +222,7 @@ let lookup_token_index name = | 'o' when name = "last-modified" -> 43 | _ -> -1) | 14 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'a' when name = "accept-charset" -> 14 | 'c' when name = "content-length" -> 27 | _ -> -1) @@ -236,24 +239,26 @@ let lookup_token_index name = | 'i' when name = "www-authenticate" -> 60 | _ -> -1) | 17 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'i' when name = "if-modified-since" -> 39 | 't' when name = "transfer-encoding" -> 56 | _ -> -1) | 18 -> - (match name.[0] with 'p' when name = "proxy-authenticate" -> 47 | _ -> -1) + (match String.unsafe_get name 0 with + | 'p' when name = "proxy-authenticate" -> 47 + | _ -> -1) | 19 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'c' when name = "content-disposition" -> 24 | 'i' when name = "if-unmodified-since" -> 42 | 'p' when name = "proxy-authorization" -> 48 | _ -> -1) | 25 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 's' when name = "strict-transport-security" -> 55 | _ -> -1) | 27 -> - (match name.[0] with + (match String.unsafe_get name 0 with | 'a' when name = "access-control-allow-origin" -> 19 | _ -> -1) | _ -> -1 diff --git a/hpack/test/hpack-test-case b/hpack/test/hpack-test-case index b2a1664..8a1406e 160000 --- a/hpack/test/hpack-test-case +++ b/hpack/test/hpack-test-case @@ -1 +1 @@ -Subproject commit b2a1664b43dc520a4bbff2e7db1b7e7af4fb43f4 +Subproject commit 8a1406e7d14bfcb6c046021f13cc15cfb162726d diff --git a/hpack/util/gen_static.ml b/hpack/util/gen_static.ml index fbfa268..59680a4 100644 --- a/hpack/util/gen_static.ml +++ b/hpack/util/gen_static.ml @@ -87,7 +87,7 @@ let find_pos names = loop 0 let make_token_map static_table = - let tbl = Hashtbl.create 60 in + let tbl = Hashtbl.create (Array.length static_table) in Array.iter (fun (i, name, _) -> let length = String.length name in @@ -96,11 +96,12 @@ let make_token_map static_table = | Some string_tbl -> string_tbl | None -> Hashtbl.create 10 in - Hashtbl.add string_tbl name i) + add_name name i string_tbl; + Hashtbl.replace tbl length string_tbl) static_table; Hashtbl.fold (fun length names ret -> - let bindings = Hashtbl.fold (fun k v lst -> (k, v) :: lst) names [] in + let bindings = Hashtbl.to_seq names |> List.of_seq in (length, find_pos names, bindings) :: ret) tbl [] @@ -147,7 +148,7 @@ let mk_lookup_token token_map = (Exp.match_ (Exp.apply (Exp.ident - { txt = Ldot (Lident "String", "get") + { txt = Ldot (Lident "String", "unsafe_get") ; loc = !default_loc }) [ ( Nolabel