open E_regexp open Lexer_generator open Batteries open Utils open Symbols let nfa_accepts (n: nfa) (w: char list) : bool = let rec trav vis s = if Set.mem s vis then vis else let en = List.filter_map (fun (oa, n) -> if oa = None then Some n else None) (n.nfa_step s) in List.fold_left trav (Set.add s vis) en in let ec s = trav Set.empty s in let ecs ls = Set.fold (fun q -> Set.union (ec q)) ls Set.empty in let rec walk (q: int set) (w: char list) = let q = ecs q in match w with | [] -> Set.exists (fun q -> List.mem q (List.map fst n.nfa_final)) q | c::w -> let q' = Set.fold Set.union (Set.map (fun q -> (List.filter_map (fun (cso,q') -> match cso with | None -> None | Some cs -> if Set.mem c cs then Some q' else None ) (n.nfa_step q)) |> Set.of_list ) q) Set.empty in walk q' w in walk (Set.of_list n.nfa_initial) w let () = let regexp_list = [ (keyword_regexp "while", fun s -> Some (SYM_WHILE)); (keyword_regexp "if", fun s -> Some (SYM_IF)); (Cat(letter_regexp, Star(identifier_material)), fun s -> Some (SYM_IDENTIFIER s)); ] in (* Décommentez la ligne suivante pour tester sur la vraie liste d'expressions régulières. *) (* let regexp_list = list_regexp in *) List.iteri (fun i (rg, _) -> Printf.printf "%d: %s\n" i (string_of_regexp rg)) regexp_list; let nfa = nfa_of_list_regexp regexp_list in Printf.printf "%s\n" (nfa_to_string nfa); let oc = open_out "/tmp/nfa.dot" in nfa_to_dot oc nfa; close_out oc; let dfa = dfa_of_nfa nfa in let oc = open_out "/tmp/dfa.dot" in dfa_to_dot oc dfa alphabet; close_out oc; let n = { nfa_states = [1; 2; 3; 4] ; nfa_initial = [1] ; nfa_final = [(3, fun s -> None); (4, fun s -> None)]; nfa_step = fun q -> match q with | 1 -> [(Some (Set.singleton '0'), 2); (None, 3)] | 2 -> [(Some (Set.singleton '1'), 2); (Some (Set.singleton '1'), 4)] | 3 -> [(Some (Set.singleton '0'), 4); (None, 2)] | 4 -> [(Some (Set.singleton '0'), 2)] | _ -> [] } in let expect_set str s_got s_exp = if Set.equal s_got s_exp then Printf.printf "[OK] %s\n" str else Printf.printf "[KO] %s : got %s, expected %s\n" str (string_of_int_set s_got) (string_of_int_set s_exp) in let ec1 = epsilon_closure n 1 in let ec2 = epsilon_closure n 2 in let ec3 = epsilon_closure n 3 in let ec4 = epsilon_closure n 4 in expect_set "epsilon_closure 1" ec1 (Set.of_list [1;2;3]); expect_set "epsilon_closure 2" ec2 (Set.of_list [2]); expect_set "epsilon_closure 3" ec3 (Set.of_list [2;3]); expect_set "epsilon_closure 4" ec4 (Set.of_list [4]); expect_set "dfa_initial_state" (dfa_initial_state n) (Set.of_list [1;2;3]); let string_of_opt_tok ot = match ot with None -> "None" | Some t -> Printf.sprintf "Some (%s)" (string_of_symbol t) in let expect_token_option str to_got to_exp = if to_got = to_exp then Printf.printf "[OK] %s\n" str else Printf.printf "[KO] %s : got %s, expected %s\n" str (string_of_opt_tok to_got) (string_of_opt_tok to_exp) in expect_token_option "min_priority 1" (min_priority [SYM_EOF; SYM_IDENTIFIER "bla"; SYM_WHILE]) (Some SYM_WHILE); expect_token_option "min_priority 2" (min_priority [SYM_EOF; SYM_IDENTIFIER "bla"]) (Some (SYM_IDENTIFIER "bla")); expect_token_option "min_priority 3" (min_priority [SYM_EOF; SYM_WHILE]) (Some SYM_WHILE); expect_token_option "min_priority 4" (min_priority []) None; let set_incl s1 s2 = Set.for_all (fun s -> Set.exists (Set.equal s) s2) s1 in let set_eq s1 s2 = set_incl s1 s2 && set_incl s2 s1 in let string_of_int_set_set s = Set.map (fun s -> Printf.sprintf "{%s}" (String.concat "," (Set.to_list (Set.map string_of_int s))) ) s |> Set.to_list |> String.concat ", " |> Printf.sprintf "{%s}" in let expect_set_set str (set_got : int set set) (set_exp : int set set) = if set_eq set_got set_exp then Printf.printf "[OK] %s\n" str else Printf.printf "[KO] %s : got %s, expected %s\n" str (string_of_int_set_set set_got) (string_of_int_set_set set_exp) in let table = Hashtbl.create 10 in build_dfa_table table n (dfa_initial_state n); expect_set_set "dfa states" (Hashtbl.keys table |> Set.of_enum) (Set.of_list [Set.of_list [1;2;3]; Set.of_list [2;4]; Set.of_list [2]]); let expect_nfa_accepts n s b = let r = nfa_accepts n (char_list_of_string s) in if r = b then Printf.printf "[OK] nfa_accepts %s = %b\n" s r else Printf.printf "[KO] nfa_accepts %s = %b\n" s r in Printf.printf "*** NFA n1 : 'hello'\n"; let n1, f1 = nfa_of_regexp (keyword_regexp "hello") 1 (fun _ -> None) in expect_nfa_accepts n1 "hello" true; expect_nfa_accepts n1 "bonjour" false; Printf.printf "*** NFA n2 : 'bonjour'\n"; let n2, f2 = nfa_of_regexp (keyword_regexp "bonjour") f1 (fun _ -> None) in expect_nfa_accepts n2 "hello" false; expect_nfa_accepts n2 "bonjour" true; Printf.printf "*** NFA n3 : n1 | n2\n"; let n3 = alt_nfa n1 n2 in expect_nfa_accepts n3 "hello" true; expect_nfa_accepts n3 "bonjour" true; expect_nfa_accepts n2 "buongiorno" false; Printf.printf "*** NFA n4 : n1 . n2 \n"; let n4 = cat_nfa n1 n2 in expect_nfa_accepts n4 "hello" false; expect_nfa_accepts n4 "bonjour" false; expect_nfa_accepts n4 "hellobonjour" true; expect_nfa_accepts n4 "bonjourhello" false; Printf.printf "*** NFA n5 : n1* \n"; let n5 = star_nfa n1 (fun _ -> None) in expect_nfa_accepts n5 "" true; expect_nfa_accepts n5 "hello" true; expect_nfa_accepts n5 "hellohello" true; expect_nfa_accepts n5 "hellobonjour" false; Printf.printf "*** NFA n6 : n3* \n"; let n6 = star_nfa n3 (fun _ -> None) in expect_nfa_accepts n6 "" true; expect_nfa_accepts n6 "hello" true; expect_nfa_accepts n6 "hellohello" true; expect_nfa_accepts n6 "hellobonjour" true; expect_nfa_accepts n6 "hellobonjourhello" true; expect_nfa_accepts n6 "bonjourbonjourbonjourhello" true; expect_nfa_accepts n6 "bonjlo" false; ignore f2