La lettre de Caml, numéro 0

Les sources des programmes Caml

parseur d'expressions régulières ; crible d'Ératosthène

Retour à la page générale de La lettre de Caml.

Parseur d'expressions régulières :

let string_of_char = make_string 1 ;;

type lexeme = 
    Car of char | Étoile | Parenthèse_gauche | Parenthèse_droite | Barre ;;

let rec lexeur flot = match flot with
      [< '`\\` ; 'x >] -> [< '(Car x) ; lexeur flot >]
    | [< '`|` >] -> [< 'Barre ; lexeur flot >]
    | [< '`*` >] -> [< 'Étoile ; lexeur flot >]
    | [< '`(` >] -> [< 'Parenthèse_gauche ; lexeur flot >]
    | [< '`)` >] -> [< 'Parenthèse_droite ; lexeur flot >]
    | [< 'x >] -> [< '(Car x) ; lexeur flot >]
    | [< >] -> [< >] ;;

include "lexeur_expression_régulière" ;;

type expression_régulière = 
      Chaîne of string
    | Caractère of char
    | Séquence of expression_régulière * expression_régulière
    | Étoilée of expression_régulière
    | Alternative of expression_régulière * expression_régulière ;;
    
let rec parse_E flot = match flot with
    [< parse_F f ; parse_E1 e1 >] -> match e1 with
              [< 'expr >] -> Alternative(f,expr)
            | [< >] -> f
and parse_E1 flot = match flot with
      [< 'Barre ; parse_E e >] -> [< 'e >]
    | [< >] -> [< >]
and parse_F flot = match flot with
    [< parse_G g ; parse_F1 f1 >] -> match f1 with
              [< 'expr >] -> Séquence(g,expr)
            | [< >] -> g
and parse_F1 flot = match flot with
      [< parse_F f >] -> [< 'f >]
    | [< >] -> [< >]
and parse_G flot = match flot with
    [< parse_H h ; parse_G1 g1 >] -> match g1 with
              [< 'bidon >] -> Étoilée(h)
            | [< >] -> h
and parse_G1 flot = match flot with
      [< 'Étoile >] -> [< 'Caractère(`?`) >]
    | [< >] -> [< >]
and parse_H flot = match flot with
      [< '(Car c) >] -> Caractère(c)
    | [< 'Parenthèse_gauche ; parse_E expr ; 'Parenthèse_droite >] -> expr ;;

let rec agrège = function
      Séquence(e1,e2)
            ->  ( match (agrège e1),(agrège e2) with
                      (Chaîne s1),(Chaîne s2) -> Chaîne (s1 ^ s2)
                    | (Chaîne s1),(Séquence ((Chaîne s2),e))
                        -> agrège (Séquence (Chaîne (s1^s2),e))
                    | (Séquence (e,(Chaîne s1))),(Chaîne s2)
                        -> agrège (Séquence (e,Chaîne(s1^s2)))
                    | e'1,e'2 -> Séquence(e'1,e'2)
                )
    | Étoilée(e1) -> Étoilée(agrège e1)
    | Alternative(e1,e2) -> Alternative((agrège e1),(agrège e2))
    | Caractère(c) -> Chaîne (string_of_char c)
    | e -> e ;;

let parseur s = agrège (parse_E (lexeur (stream_of_string s))) ;;

Crible d'Ératosthène :

(* version avec les flots *)

let rec à_partir_de n = [< 'n ; (à_partir_de (n+1)) >] ;;

let rec filtre_stream f flot = match flot with
    | [< 'x >] ->   if f(x) then [< 'x ; (filtre_stream f flot) >]
                    else [< (filtre_stream f flot) >]
    | [< >] -> [< >] ;;
    
let ne_divise_pas a b = (b mod a) <> 0 ;;

let rec crible flot = match flot with
    | [< 'n >] ->   [<
                        'n ; 
                        (crible (filtre_stream (ne_divise_pas n) flot))
                    >]
    | [< >] -> [< >] ;;
    
let nombres_premiers = crible (à_partir_de 2) ;;

let rec list_and_stream n flot =
    if n = 0 then [] , flot
    else match flot with [< 'x >]
            ->  let l,f = list_and_stream (n-1) flot
                in
                (x :: l) , f ;;
                
let list_of_stream n flot = fst (list_and_stream n flot) ;;

(* version sans les flots *)

type 'a suite_infinie = Nil | Cellule of (unit -> 'a * 'a suite_infinie) ;;

exception Suite_Vide ;;

let cons x l =
    let f () = (x,l)
    in Cellule f  ;;
    
let tête = function
      Nil -> raise Suite_Vide
    | Cellule f -> match f() with x,_ -> x ;;
    
let queue = function
      Nil -> raise Suite_Vide
    | Cellule f -> match f() with _,q -> q ;;
    
let est_vide = function
      Nil -> true
    | _ -> false ;;

let rec force n l = match n,l with
      0,l -> [],l
    | n,Nil -> raise Suite_Vide
    | n,Cellule f ->
            match f() with x,q ->   let liste,reste = force (n-1) q
                                    in x :: liste,reste ;;

let rec à_partir_de n = let f () = n,(à_partir_de (n+1)) in Cellule f ;;

let premiers n l = match force n l with liste,_ -> liste ;;
let reste n l = match force n l with _,r -> r ;;

let rec filtre prédicat = function
      Nil -> Nil
    | Cellule f -> match f() with x,q ->
        if (prédicat x) then
            let g () = x,(filtre prédicat q)
            in Cellule g
        else filtre prédicat q ;;
        
let non_multiple a b = (b mod a) <> 0 ;;

let élimine x l = filtre (non_multiple x) l ;;

let rec crible = function
      Nil -> raise Suite_Vide
    | Cellule f -> match f() with x,q -> 
            let g() = x,(crible (élimine x q))
            in Cellule g ;;
    
let nombres_premiers = crible (à_partir_de 2) ;;

Retour à la page générale de La lettre de Caml.