(* \texttt{mem} teste si une liste un élément donné. \texttt{merge} prend deux listes triées et renvoie une liste triée. \texttt{exists} teste si dans une liste un élément donné renvoie vrai pour une fonction de prédicat. \texttt{iter} applique une fonction sans valeur de retour à tous les éléments d'une liste. \texttt{map} prend une fonction et une liste et renvoie la liste image par la fonction ($l_1, …, l_n$ devient $f(l_1), …, f(l_n)$). \item \texttt{flatten} applique une fonction sans valeur de retour à tous les éléments d'une liste. L = aa(a+ba)*ba = a L_0 L_0 = a(a+ba)*ba = aL_1 L_1 = (a+ba)*ba = a L_1 | b L_2 // L_2$ représente l'expression a((a+ba)*ba | \epsilon) L_2 = a L_3 L_3 = \epsilon | L_1 On peut donc faire un automate à 5 états dont les états sont les $L$,$L_0$,…,$L_3$. *) type 'a automate = { initial : 'a ; transition : 'a -> char -> 'a ; finaux : 'a list };; let reconnait au = let rec run i = function | [] -> List.mem i au.finaux | a::q -> run (au.transition i a) q in run au.initial ;; type 'a automate = { initial : 'a list ; transition : 'a -> char -> 'a list ; finaux : 'a list };; let reconnaitBourrin au mot = let rec run mot i = match mot with | [] -> List.mem i au.finaux | a::q -> List.exists (run q) (au.transition i a) in List.exists (run mot) au.initial ;; let rec union l1 l2 = match l1 with | a::q -> if List.mem a l2 then union q l2 else a::union q l2 | [] -> l2 ;; let reconnait au mot = let rec avance lettre res = function | [] -> res | a::q -> avance lettre (union res (au.transition a lettre)) q and run etats = function | [] -> List.exists (fun e -> List.mem e au.finaux) etats | a::q -> run (avance a [] etats) q in run au.initial ;; type 'a automate = { initial : 'a list ; transition : 'a -> char -> 'a list ; finaux : 'a list };; let combine l l' = List.flatten (List.map (fun y -> List.map (fun x -> x,y) l) l') ;; type ('a,'b) etat = | Premier of 'a | Second of 'b ;; let concat a b = let b_start = List.map (fun e -> Second e) b.initial in let b_at_start = if List.exists (fun f -> List.mem f a.finaux) a.initial then b_start else [] in { initial = b_at_start @ (List.map (fun e -> Premier e) a.initial) ; transition = (fun e c -> (match e with | Premier p -> ( if List.mem p a.finaux then List.flatten (List.map (fun e -> List.map (fun f -> Second f) (b.transition e c)) b.initial ) else []) @ (List.map (fun f -> Premier f) (a.transition p c)) | Second s -> List.map (fun f -> Second f) (b.transition s c))) ; finaux = List.map (fun f -> Second f) b.finaux } ;; let produit a b = { initial = combine a.initial b.initial ; transition = (fun (x,y) c -> combine (a.transition x c) (b.transition y c)) ; finaux = combine a.finaux b.finaux } type expression = | Etoile of expression | Concat of expression*expression | Lettre of char | Union of expression*expression | Vide ;; let etoite a = { initial = a.initial ; final = List.merge a.final a.initial