+9 -1

lib/automata.ml

··· 629 629 && Desc.equal desc t.desc 630 630 ;; 631 631 632 632 - let status s = 632 632 + (* To be called when the mutex has already been acquired *) 633 633 + let status_no_mutex s = 633 634 match s.status with 634 635 | Some s -> s 635 636 | None -> 636 637 let st = Desc.status s.desc in 637 638 s.status <- Some st; 638 639 st 640 640 + ;; 641 641 + 642 642 + let status m s = 643 643 + Mutex.lock m; 644 644 + let st = status_no_mutex s in 645 645 + Mutex.unlock m; 646 646 + st 639 647 ;; 640 648 641 649 module Table = Hashtbl.Make (struct

+2 -1

lib/automata.mli

··· 102 102 val dummy : t 103 103 val create : Category.t -> expr -> t 104 104 val idx : t -> Idx.t 105 105 - val status : t -> Status.t 105 105 + val status_no_mutex : t -> Status.t 106 106 + val status : Mutex.t -> t -> Status.t 106 107 val to_dyn : t -> Dyn.t 107 108 108 109 module Table : Hashtbl.S with type key = t

+46 -24

lib/compile.ml

··· 105 105 ; (* States of the deterministic automata *) 106 106 group_names : (string * int) list 107 107 ; (* Named groups in the regular expression *) 108 108 - group_count : int (* Number of groups in the regular expression *) 108 108 + group_count : int 109 109 + ; (* Number of groups in the regular expression *) 110 110 + mutex : Mutex.t 109 111 } 110 112 111 113 let pp_re ch re = Automata.pp ch re.initial ··· 169 171 | Not_found -> 170 172 let st = 171 173 let break_state = 172 172 - match Automata.State.status desc with 174 174 + match Automata.State.status_no_mutex desc with 173 175 | Running -> false 174 176 | Failed | Match _ -> true 175 177 in ··· 193 195 194 196 let validate re (s : string) ~pos st = 195 197 let color = Color_map.Table.get re.colors s.[pos] in 198 198 + Mutex.lock re.mutex; 196 199 let st' = 197 200 let desc' = 198 201 let cat = category re ~color in ··· 200 203 in 201 204 find_state re desc' 202 205 in 203 203 - State.set_transition st ~color st' 206 206 + State.set_transition st ~color st'; 207 207 + Mutex.unlock re.mutex 204 208 ;; 205 209 206 206 - let next colors st s pos = 207 207 - State.follow_transition st ~color:(Color_map.Table.get colors (String.unsafe_get s pos)) 210 210 + let next mutex colors st s pos = 211 211 + Mutex.lock mutex; 212 212 + let res = 213 213 + State.follow_transition st ~color:(Color_map.Table.get colors (String.unsafe_get s pos)) 214 214 + in 215 215 + Mutex.unlock mutex; 216 216 + res 208 217 ;; 209 218 210 219 let rec loop re ~colors ~positions s ~pos ~last st0 st = 211 220 if pos < last 212 221 then ( 213 213 - let st' = next colors st s pos in 222 222 + let st' = next re.mutex colors st s pos in 214 223 let idx = (State.get_info st').idx in 215 224 if Idx.is_idx idx 216 225 then ··· 236 245 let rec loop_no_mark re ~colors s ~pos ~last st0 st = 237 246 if pos < last 238 247 then ( 239 239 - let st' = next colors st s pos in 248 248 + let st' = next re.mutex colors st s pos in 240 249 let idx = (State.get_info st').idx in 241 250 if Idx.is_idx idx 242 251 then loop_no_mark re ~colors s ~pos:(pos + 1) ~last st' st' ··· 250 259 ;; 251 260 252 261 let final re st cat = 253 253 - try List.assq cat st.final with 254 254 - | Not_found -> 255 255 - let st' = delta re cat ~color:Cset.null_char st in 256 256 - let res = Automata.State.idx st', Automata.State.status st' in 257 257 - st.final <- (cat, res) :: st.final; 258 258 - res 262 262 + Mutex.lock re.mutex; 263 263 + let res = 264 264 + try List.assq cat st.final with 265 265 + | Not_found -> 266 266 + let st' = delta re cat ~color:Cset.null_char st in 267 267 + let res = Automata.State.idx st', Automata.State.status_no_mutex st' in 268 268 + st.final <- (cat, res) :: st.final; 269 269 + res 270 270 + in 271 271 + Mutex.unlock re.mutex; 272 272 + res 259 273 ;; 260 274 261 275 let find_initial_state re cat = 262 262 - try List.assq cat re.initial_states with 263 263 - | Not_found -> 264 264 - let st = find_state re (Automata.State.create cat re.initial) in 265 265 - re.initial_states <- (cat, st) :: re.initial_states; 266 266 - st 276 276 + Mutex.lock re.mutex; 277 277 + let res = 278 278 + try List.assq cat re.initial_states with 279 279 + | Not_found -> 280 280 + let st = find_state re (Automata.State.create cat re.initial) in 281 281 + re.initial_states <- (cat, st) :: re.initial_states; 282 282 + st 283 283 + in 284 284 + Mutex.unlock re.mutex; 285 285 + res 267 286 ;; 268 287 269 288 let get_color re (s : string) pos = ··· 295 314 else ( 296 315 (* Unknown *) 297 316 let color = re.lnl in 317 317 + Mutex.lock re.mutex; 298 318 let st' = 299 319 let desc = 300 320 let cat = category re ~color in ··· 304 324 find_state re desc 305 325 in 306 326 State.set_transition st ~color st'; 327 327 + Mutex.unlock re.mutex; 307 328 handle_last_newline re positions ~pos st ~groups) 308 329 ;; 309 330 ··· 360 381 in 361 382 let state_info = State.get_info st in 362 383 if Idx.is_break state_info.idx || (partial && not groups) 363 363 - then Automata.State.status state_info.desc 384 384 + then Automata.State.status re.mutex state_info.desc 364 385 else if partial && groups 365 386 then ( 366 366 - match Automata.State.status state_info.desc with 387 387 + match Automata.State.status re.mutex state_info.desc with 367 388 | (Match _ | Failed) as status -> status 368 389 | Running -> 369 390 (* This could be because it's still not fully matched, or it ··· 401 422 let info = State.get_info state in 402 423 if Idx.is_break info.idx 403 424 && 404 404 - match Automata.State.status info.desc with 425 425 + match Automata.State.status t.re.mutex info.desc with 405 426 | Failed -> true 406 427 | Match _ | Running -> false 407 428 then No_match ··· 472 493 let rec loop re ~abs_pos ~colors ~positions s ~pos ~last st0 st = 473 494 if pos < last 474 495 then ( 475 475 - let st' = next colors st s pos in 496 496 + let st' = next re.mutex colors st s pos in 476 497 let idx = (State.get_info st').idx in 477 498 if Idx.is_idx idx 478 499 then ··· 504 525 let info = State.get_info state in 505 526 if Idx.is_break info.idx 506 527 && 507 507 - match Automata.State.status info.desc with 528 528 + match Automata.State.status t.re.mutex info.desc with 508 529 | Failed -> true 509 530 | Match _ | Running -> false 510 531 then No_match ··· 533 554 State.get_info state 534 555 in 535 556 match 536 536 - match Automata.State.status info.desc with 557 557 + match Automata.State.status t.re.mutex info.desc with 537 558 | (Match _ | Failed) as s -> s 538 559 | Running -> 539 560 let idx, res = ··· 597 618 ; states = Automata.State.Table.create 97 598 619 ; group_names 599 620 ; group_count 621 621 + ; mutex = Mutex.create () 600 622 } 601 623 ;; 602 624

+1 -1

lib_test/expect/test_automata.ml

··· 37 37 if n > 0 38 38 then ( 39 39 print_dyn (State.to_dyn d); 40 40 - match State.status d with 40 40 + match State.status_no_mutex d with 41 41 | Failed -> Format.printf "> failed@." 42 42 | Match _ -> Format.printf "> matched@." 43 43 | Running ->