package ppx_inline_test_nobase
Syntax extension for writing in-line tests in ocaml code (with stripped dependencies)
Install
Dune Dependency
Authors
Maintainers
Sources
v0.17+nobase.tar.gz
sha256=325d06a56355e2ad500bf1fb3ddbae8aabb9e9d00713a453bd3da7235bf0ed36
doc/src/ppx_inline_test_nobase.runtime-lib/search_pattern.ml.html
Source file search_pattern.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267
open String let caseless_equal c1 c2 = Char.equal (Char.lowercase_ascii c1) (Char.lowercase_ascii c2) module Search_pattern0 = struct type t = { pattern : string ; case_sensitive : bool ; kmp_array : int array } (* let sexp_of_t { pattern; case_sensitive; kmp_array = _ } : Sexp.t = List [ List [ Atom "pattern"; sexp_of_string pattern ] ; List [ Atom "case_sensitive"; sexp_of_bool case_sensitive ] ] ;; *) let pattern t = t.pattern let case_sensitive t = t.case_sensitive (* Find max number of matched characters at [next_text_char], given the current [matched_chars]. Try to extend the current match, if chars don't match, try to match fewer chars. If chars match then extend the match. *) let kmp_internal_loop ~matched_chars ~next_text_char ~pattern ~kmp_array ~char_equal = let matched_chars = ref matched_chars in while !matched_chars > 0 && not (char_equal next_text_char (String.unsafe_get pattern !matched_chars)) do matched_chars := Array.unsafe_get kmp_array (!matched_chars - 1) done; if char_equal next_text_char (String.unsafe_get pattern !matched_chars) then matched_chars := !matched_chars + 1; !matched_chars ;; let get_char_equal ~case_sensitive = match case_sensitive with | true -> Char.equal | false -> caseless_equal ;; (* Classic KMP pre-processing of the pattern: build the int array, which, for each i, contains the length of the longest non-trivial prefix of s which is equal to a suffix ending at s.[i] *) let create pattern ~case_sensitive = let n = length pattern in let kmp_array = Stdlib.Array.make n (-1) in if n > 0 then ( let char_equal = get_char_equal ~case_sensitive in Array.unsafe_set kmp_array 0 0; let matched_chars = ref 0 in for i = 1 to n - 1 do matched_chars := kmp_internal_loop ~matched_chars:!matched_chars ~next_text_char:(unsafe_get pattern i) ~pattern ~kmp_array ~char_equal; Array.unsafe_set kmp_array i !matched_chars done); { pattern; case_sensitive; kmp_array } ;; (* Classic KMP: use the pre-processed pattern to optimize look-behinds on non-matches. We return int to avoid allocation in [index_exn]. -1 means no match. *) let index_internal ?(pos = 0) { pattern; case_sensitive; kmp_array } ~in_:text = if pos < 0 || pos > length text - length pattern then -1 else ( let char_equal = get_char_equal ~case_sensitive in let j = ref pos in let matched_chars = ref 0 in let k = length pattern in let n = length text in while !j < n && !matched_chars < k do let next_text_char = unsafe_get text !j in matched_chars := kmp_internal_loop ~matched_chars:!matched_chars ~next_text_char ~pattern ~kmp_array ~char_equal; j := !j + 1 done; if !matched_chars = k then !j - k else -1) ;; let matches t str = index_internal t ~in_:str >= 0 let index ?pos t ~in_ = let p = index_internal ?pos t ~in_ in if p < 0 then None else Some p ;; let index_exn ?pos t ~in_ = let p = index_internal ?pos t ~in_ in if p >= 0 then p else failwith (Printf.sprintf "Substring %S not found " t.pattern) (* raise_s (Sexp.message "Substring not found" [ "substring", sexp_of_string t.pattern ]) *) ;; let index_all { pattern; case_sensitive; kmp_array } ~may_overlap ~in_:text = if length pattern = 0 then List.init (1 + length text) Fun.id else ( let char_equal = get_char_equal ~case_sensitive in let matched_chars = ref 0 in let k = length pattern in let n = length text in let found = ref [] in for j = 0 to n do if !matched_chars = k then ( found := (j - k) :: !found; (* we just found a match in the previous iteration *) match may_overlap with | true -> matched_chars := Array.unsafe_get kmp_array (k - 1) | false -> matched_chars := 0); if j < n then ( let next_text_char = unsafe_get text j in matched_chars := kmp_internal_loop ~matched_chars:!matched_chars ~next_text_char ~pattern ~kmp_array ~char_equal) done; List.rev !found) ;; let replace_first ?pos t ~in_:s ~with_ = match index ?pos t ~in_:s with | None -> s | Some i -> let len_s = length s in let len_t = length t.pattern in let len_with = length with_ in let dst = Bytes.create (len_s + len_with - len_t) in BytesLabels.blit_string ~src:s ~src_pos:0 ~dst ~dst_pos:0 ~len:i; BytesLabels.blit_string ~src:with_ ~src_pos:0 ~dst ~dst_pos:i ~len:len_with; BytesLabels.blit_string ~src:s ~src_pos:(i + len_t) ~dst ~dst_pos:(i + len_with) ~len:(len_s - i - len_t); Bytes.unsafe_to_string dst ;; let replace_all t ~in_:s ~with_ = let matches = index_all t ~may_overlap:false ~in_:s in match matches with | [] -> s | _ :: _ -> let len_s = length s in let len_t = length t.pattern in let len_with = length with_ in let num_matches = List.length matches in let dst = Bytes.create (len_s + ((len_with - len_t) * num_matches)) in let next_dst_pos = ref 0 in let next_src_pos = ref 0 in ListLabels.iter matches ~f:(fun i -> let len = i - !next_src_pos in BytesLabels.blit_string ~src:s ~src_pos:!next_src_pos ~dst ~dst_pos:!next_dst_pos ~len; BytesLabels.blit_string ~src:with_ ~src_pos:0 ~dst ~dst_pos:(!next_dst_pos + len) ~len:len_with; next_dst_pos := !next_dst_pos + len + len_with; next_src_pos := !next_src_pos + len + len_t); BytesLabels.blit_string ~src:s ~src_pos:!next_src_pos ~dst ~dst_pos:!next_dst_pos ~len:(len_s - !next_src_pos); Bytes.unsafe_to_string dst ;; let split_on t s = let pattern_len = String.length t.pattern in let matches = index_all t ~may_overlap:false ~in_:s in ListLabels.map2 (-pattern_len :: matches) (matches @ [ String.length s ]) ~f:(fun i j -> StringLabels.sub s ~pos:(i + pattern_len) ~len:(j - i - pattern_len)) ;; (* module Private = struct type public = t type nonrec t = t = { pattern : string ; case_sensitive : bool ; kmp_array : int array } [@@deriving_inline equal, sexp_of] let equal = (fun a__003_ b__004_ -> if Stdlib.( == ) a__003_ b__004_ then true else Stdlib.( && ) (equal_string a__003_.pattern b__004_.pattern) (Stdlib.( && ) (equal_bool a__003_.case_sensitive b__004_.case_sensitive) (equal_array equal_int a__003_.kmp_array b__004_.kmp_array)) : t -> t -> bool) ;; let sexp_of_t = (fun { pattern = pattern__008_ ; case_sensitive = case_sensitive__010_ ; kmp_array = kmp_array__012_ } -> let bnds__007_ = ([] : _ Stdlib.List.t) in let bnds__007_ = let arg__013_ = sexp_of_array sexp_of_int kmp_array__012_ in (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "kmp_array"; arg__013_ ] :: bnds__007_ : _ Stdlib.List.t) in let bnds__007_ = let arg__011_ = sexp_of_bool case_sensitive__010_ in (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "case_sensitive"; arg__011_ ] :: bnds__007_ : _ Stdlib.List.t) in let bnds__007_ = let arg__009_ = sexp_of_string pattern__008_ in (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pattern"; arg__009_ ] :: bnds__007_ : _ Stdlib.List.t) in Sexplib0.Sexp.List bnds__007_ : t -> Sexplib0.Sexp.t) ;; [@@@end] let representation = Fun.id end *) end include Search_pattern0 let create ?(case_sensitive = true) pattern = create pattern ~case_sensitive let substr_index_gen ~case_sensitive ?pos t ~pattern = index ?pos (create ~case_sensitive pattern) ~in_:t ;; let is_substring_gen ~case_sensitive t ~substring = Option.is_some (substr_index_gen t ~pattern:substring ~case_sensitive) ;; let is_substring = is_substring_gen ~case_sensitive:true
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>