.ocamlformat

+profile = default
+margin = 80
\ No newline at end of file

CONFIGURATION.md

@@ -11,16 +11,20 @@ test -r /home/tpetu/Enseignants/emmanuel.coquery/opam/opam-init/init.sh && . /ho
 ```
 
 > Sur une machine personnelle, installer ocaml et opam via les paquets, par exemple sous ubuntu:
-> ```
+>
+> ```shell
 > sudo apt install ocaml opam
 > ```
+>
 > sous Mac OS X avec Homebrew:
-> ```
+>
+> ```shell
 > brew install ocaml opam
 > ```
 >
 > Dans un shell, lancer les commandes suivantes:
-> ```
+>
+> ```shell
 > opam init
 > # Suivre s'il faut les instructions de configuration de l'environnement
 > opam install ocaml-lsp-server
@@ -30,4 +34,4 @@ On utilisera VSCode en installant le plugin **OCaml Platform**.
 
 Pour supprimer les lignes verticales d'indentation qui peuvent perturber al'affichage avec les `|` des `match`: aller dans le menu File -> Preferences -> Settings, entrer `editor.guide` dans la zone de recherche et décocher la case "Editor > Guides: Indentation". Vérifiez que vous êtes bien dans l'onglet "User" quand vous décochez la case. Voir le screenshot ci-dessous:
 
-![](files/config_lignes_vscode.png)
+![config vs code](files/config_lignes_vscode.png)

README.md

 # UE LIFPF INF2030L Programmation Fonctionnelle
 
-## Semestre 2023 Printemps
+## Semestre 2025 Printemps
 
 - [Configuration pour la salle de TP](CONFIGURATION.md)
 - [Rappels git et gitlab](gitlab.md)
 - [Questions sur le cours](https://forge.univ-lyon1.fr/programmation-fonctionnelle/lifpf/-/issues/?sort=updated_desc&state=all&label_name%5B%5D=Question)
 
-| jour  | heure         | type          | supports / remarques                                                                      |
-| ----- | ------------- | ------------- | ----------------------------------------------------------------------------------------- |
-| 16/01 | 8h            | CM            | [Diapositives](cm/lifpf-cm1.pdf)                                                          |
-|       | 9h45          | TD            | [Sujet](td/lifpf-td1-enonce.pdf), [corrigé](td/lifpf-td1-correction.pdf)                  |
-| 23/01 | 8h            | CM            | [Diapositives](cm/lifpf-cm2.pdf), [Script démos](cm/cm2-demo.md)                          |
-|       | 9h45 ou 11h30 | TP            | [Sujet](tp/tp1.md), [corrigé](tp/tp1.ml) <br> Groupe de TP, horaire et salle sur [tomuss] |
-| 30/01 | 8h            | TD + QCM      | [Sujet](td/lifpf-td2-enonce.pdf), [corrigé](td/lifpf-td2-correction.pdf)                  |
-|       | 9h45 ou 11h30 | TP            | [Sujet](tp/tp2.md), [corrigé](tp/tp2.ml) <br> Groupe de TP, horaire et salle sur [tomuss] |
-| 20/02 | 8h            | CM            | [Diapositives](cm/lifpf-cm3.pdf)                                                          |
-|       | 9h45 ou 11h30 | TP            | [Sujet](tp/tp3.md), [corrigé](tp/tp3.ml)                                                  |
-| 27/02 | 8h            | TD + QCM      | [Sujet](td/lifpf-td3-enonce.pdf), [corrigé](td/lifpf-td3-correction.pdf)                  |
-|       | 9h45 ou 11h30 | TP            | [Sujet](tp/tp4.md), [corrigé](tp/tp4.ml)                                                  |
-| 06/03 | 8h            | CM            | [Diapositives](cm/lifpf-cm4.pdf)                                                          |
-|       | 9h45          | TD + QCM      | [Sujet](td/lifpf-td4-enonce.pdf), [corrigé](td/lifpf-td4-correction.pdf)                  |
-| 13/03 | 8h            | CM            | [Diapositives](cm/lifpf-cm5.pdf)                                                          |
-|       | 9h45 ou 11h30 | TP            | [Sujet](tp/tp5.md), [corrigé de l'exercice 1](tp/tp5.ml)                                  |
-| 20/03 | 8h            | TD + QCM      | [Sujet](td/lifpf-td5-enonce.pdf), [corrigé](td/lifpf-td5-correction.pdf)                  |
-|       | 9h45 ou 11h30 | TP            | [Sujet](tp/tp6.md), corrigés dans la TD/TPs référencés dans le sujet                      |
-| 27/03 | 9h45 ou 11h15 | TP            | [Sujet](tp/tp7.md)                                                                        |
-| 03/04 | 8h            | CM            |                                                                                           |
-|       | 9h45          | TD + Contrôle |                                                                                           |
-
-###### Évaluation
-
-- <del>5</del> 4 QCMs + 1 contrôle en TD: 60 %
-- ECA: 40%
+(2024) indique qu'il s'agit des supports de l'an dernier qui sont à mettre à jour
+
+| jour  | heure         | type       | sujet                       | supports / remarques                                                                              |
+| ----- | ------------- | ---------- | --------------------------- | ------------------------------------------------------------------------------------------------- |
+| 20/01 | 8h            | CM1        | Intro & Lambda-Calcul       | [Diapositives Intro](cm/lifpf-cm0.pdf), [Diapositives Cours](cm/lifpf-cm1.pdf)                    |
+|       | 9h45          | TD1 sauf B | Lambda-Calcul               | [Sujet](td/lifpf-td1-enonce.pdf), [corrigé](td/lifpf-td1-correction.pdf)                          |
+|       | 11h30         | TD1 Grp B  |                             |                                                                                                   |
+| 27/01 | 8h            | CM2        | OCaml                       | [Diapositives](cm/lifpf-cm2.pdf), [Script démos](cm/cm2-demo.md)                                  |
+|       | 9h45 ou 11h30 | TP1        | Prise en main               | [Sujet](tp/tp1.md), [corrigé](tp/tp1.ml)                                                          |
+| 03/02 | 8h            | TD2        | Lambda-Calcul               | [Sujet](td/lifpf-td2-enonce.pdf), [corrigé](td/lifpf-td2-correction.pdf)                          |
+|       | 9h45 ou 11h30 | TP2        | Listes                      | [Sujet](tp/tp2.md), [corrigé](tp/tp2.ml)                                                          |
+| 10/02 | 8h            | CM3        | Struct. ind. + types param. | [Diapositives](cm/lifpf-cm3.pdf) [code](cm/cm3-code.ml)                                           |
+|       | 9h45 ou 11h30 | TP3        | Arbres                      | [Sujet](tp/tp3.md) [corrigé](tp/tp3.ml)                                                           |
+| 17/02 | 8h            | TD3        | Arbres                      | [Sujet](td/lifpf-td3-enonce.pdf), [corrigé](td/lifpf-td3-correction.pdf)                          |
+|       | 9h45 ou 11h30 | TP4        | Arbres génériques           | [Sujet](tp/tp4.md), [corrigé](tp/tp4.ml)                                                          |
+| 24/02 | 9h45          | Partiel    |                             | Amphi et place communiqués dans tomuss, 1 feuille manuscrite recto/verso autorisée comme document |
+| 10/03 | 8h            | CM4        | Ordre sup.                  | [Diapositives](cm/lifpf-cm4.pdf)                                                                  |
+|       | 9h45          | TD4        | Ordre sup.                  | [Sujet](td/lifpf-td4-enonce.pdf), [corrigé](td/lifpf-td4-correction.pdf)                          |
+| 17/03 | 8h            | CM5        | Modules                     | [Diapositives](cm/lifpf-cm5.pdf)                                                                  |
+|       | 9h45 ou 11h30 | TP5        | Struct. gen.                | [Sujet](tp/tp5.md), [corrigé](tp/tp5.ml)                                                          |
+| 24/03 | 8h            | TD5        | Ordre sup.                  | [Sujet](td/lifpf-td5-enonce.pdf)                                                                  |
+|       | 9h45 ou 11h30 | TP6        | Transf. struct.             | [Sujet](tp/tp6.md)                                                                                |
+| 31/03 | 9h45 ou 11h15 | TP7        | App. OCaml (à changer ?)    | (2024) [Sujet](tp/tp7.md)                                                                         |
+| 07/04 | 8h            | CM6        | Foncteurs                   | (2024) [Diapositives](cm/lifpf-cm6.pdf), [code](cm/cm6-code.ml)                                   |
+|       | 9h45          | TD6        | Foncteurs                   | (2024) [Sujet](td/lifpf-td6-enonce.pdf)                                                           |
+| 14/04 |               | TP8        | à déterminer                | remplace les soutenances                                                                          |
+
+### Annales
 
-Selon l'avancement du cours, il est possible qu'il y ait un TP noté lors de la dernière séance. Dans ce cas, il comptera dans les 60% des QCMs
+- [Printemps 2023, session 1](annales/ccf-2023p-s1.pdf), [corrigé](annales/ccf-2023p-s1-corrige.ml)
 
-[tomuss]: https://tomuss.univ-lyon1.fr
+### Évaluation
+
+- en TP: 30%
+- CC intermédiaire (partiel): 30%
+- ECA: 40%

annales/ccf-2023p-s1-corrige.ml

+(* Listes et paires *)
+(* Questions 1 & 2 *)
+let rec map2 (f : 'a -> 'b -> 'c) (l1 : 'a list) (l2 : 'b list) :
+    'c list =
+  match (l1, l2) with
+  | [], _ -> []
+  | _, [] -> []
+  | x1 :: l1', x2 :: l2' -> f x1 x2 :: map2 f l1' l2'
+
+(* Questions 3 & 4 *)
+let rec zip (l1 : 'a list) (l2 : 'b list) : ('a * 'b) list =
+  match (l1, l2) with
+  | [], _ -> []
+  | _, [] -> []
+  | x1 :: l1', x2 :: l2' -> (x1, x2) :: zip l1' l2'
+
+(* Questions 5 & 6 *)
+let unzip (l : ('a * 'b) list) : 'a list * 'b list =
+  List.fold_right
+    (fun p pl -> (fst p :: fst pl, snd p :: snd pl))
+    l ([], [])
+
+(* Question 7 *)
+let map2 (f : 'a -> 'b -> 'c) (l1 : 'a list) (l2 : 'b list) :
+    'c list =
+  List.map (fun p -> f (fst p) (snd p)) (zip l1 l2)
+
+(* Expressions booléennes *)
+(* Question 8 *)
+type boolexpr =
+  | Var of string
+  | Vrai
+  | Non of boolexpr
+  | Et of boolexpr * boolexpr
+
+(* Questions 9 & 10 *)
+let rec eval (env : (string * bool) list) (expr : boolexpr) :
+    bool option =
+  match expr with
+  | Var v -> List.assoc_opt v env
+  | Vrai -> Some true
+  | Non expr' -> (
+      match eval env expr' with
+      | None -> None
+      | Some b -> Some (not b))
+  | Et (expr1, expr2) -> (
+      match (eval env expr1, eval env expr2) with
+      | Some b1, Some b2 -> Some (b1 && b2)
+      | _, _ -> None)
+
+(* Modules et arbres de recherche *)
+
+(* Donné dans l'énoncé *)
+module type Cmp = sig
+  type t
+  type cmp_t = Lt | Gt | Eq
+
+  val cmp : t -> t -> cmp_t
+end
+
+(* Question 11 *)
+module type ENS_T = sig
+  type ens
+  type elt
+
+  val appartient : elt -> ens -> bool
+  val insere : elt -> ens -> ens
+end
+
+module ABR_T (M : Cmp) : ENS_T with type elt = M.t = struct
+  (* Question 12 *)
+  type ens = Vide | Noeud of (M.t * ens * ens)
+  type elt = M.t
+
+  (* Question 13 *)
+  let rec appartient v a =
+    match a with
+    | Vide -> false
+    | Noeud (v2, fg, fd) -> (
+        match M.cmp v v2 with
+        | Lt -> appartient v fg
+        | Gt -> appartient v fd
+        | Eq -> true)
+
+  (* Question 14 *)
+  let rec insere v a =
+    match a with
+    | Vide -> Noeud (v, Vide, Vide)
+    | Noeud (v2, fg, fd) -> (
+        match M.cmp v v2 with
+        | Lt -> Noeud (v2, insere v fg, fd)
+        | Gt -> Noeud (v2, fg, insere v fd)
+        | Eq -> a)
+end

cm/cm3-code.ml

+type 'a arbre_bin_g =
+  | ABGVide
+  | ABGNoeud of 'a * 'a arbre_bin_g * 'a arbre_bin_g
+
+(** Version naive du contenu d'un arbre binaire *)
+let rec contenu_naif (arb : 'a arbre_bin_g) : 'a list =
+  match arb with
+  | ABGVide -> []
+  | ABGNoeud (e, fg, fd) -> contenu_naif fg @ (e :: contenu_naif fd)
+
+let a1 = ABGNoeud (1, ABGVide, ABGVide)
+let a2 = ABGNoeud (9, ABGVide, ABGVide)
+let a3 = ABGNoeud (3, ABGVide, ABGVide)
+let a4 = ABGNoeud (7, ABGVide, ABGVide)
+let a5 = ABGNoeud (2, a1, a3)
+let a6 = ABGNoeud (8, a4, a2)
+let a7 = ABGNoeud (5, a5, a6);;
+
+contenu_naif a7
+
+(** [ajoute_contenu arb l] ajoute les élements de arb en tête des éléments de la
+    liste l *)
+let rec ajoute_contenu (arb : 'a arbre_bin_g) (l : 'a list) : 'a list =
+  match arb with
+  | ABGVide -> l
+  | ABGNoeud (e, fg, fd) ->
+      let l_fd = ajoute_contenu fd l in
+      let l_e_fd = e :: l_fd in
+      ajoute_contenu fg l_e_fd
+
+let contenu (arb : 'a arbre_bin_g) : 'a list = ajoute_contenu arb []

cm/cm6-code.ml

+module AssocList = struct
+  type key = string
+  type 'a t = (string * 'a) list
+
+  let empty : 'a t = []
+  let put (k : key) (v : 'a) (a : 'a t) : 'a t = (k, v) :: a
+  let get : key -> 'a t -> 'a option = List.assoc_opt
+
+  let keys (a : 'a t) : key list =
+    List.fold_left
+      (fun acc (k, v) ->
+        if List.mem k acc then acc else k :: acc)
+      [] a
+end
+
+module type SAssoc = sig
+  type key
+  type 'a t
+
+  val empty : 'a t
+  val put : key -> 'a -> 'a t -> 'a t
+  val get : key -> 'a t -> 'a option
+  val keys : 'a t -> key list
+end
+
+module AssocTreePb : SAssoc = struct
+  type key = string
+  type 'a t = Vide | Noeud of (string * 'a * 'a t * 'a t)
+
+  let empty = Vide
+
+  let rec put k v a =
+    match a with
+    | Vide -> Noeud (k, v, Vide, Vide)
+    | Noeud (k', v', fg, fd) ->
+        if k = k' then Noeud (k, v, fg, fd)
+        else if k < k' then Noeud (k', v', put k v fg, fd)
+        else Noeud (k', v', fg, put k v fd)
+
+  let rec get k a =
+    match a with
+    | Vide -> None
+    | Noeud (k', v', fg, fd) ->
+        if k = k' then Some v'
+        else if k < k' then get k fg
+        else get k fd
+
+  let rec keys =
+    let rec aux a ks =
+      match a with
+      | Vide -> ks
+      | Noeud (k, _, fg, fd) -> k :: aux fg (aux fd ks)
+    in
+    fun a -> aux a []
+end
+
+let a = AssocTreePb.put "toto" 3 AssocTreePb.empty
+
+module AssocTree : SAssoc with type key = string = struct
+  type key = string
+  type 'a t = Vide | Noeud of (string * 'a * 'a t * 'a t)
+
+  let empty = Vide
+
+  let rec put k v a =
+    match a with
+    | Vide -> Noeud (k, v, Vide, Vide)
+    | Noeud (k', v', fg, fd) ->
+        if k = k' then Noeud (k, v, fg, fd)
+        else if k < k' then Noeud (k', v', put k v fg, fd)
+        else Noeud (k', v', fg, put k v fd)
+
+  let rec get k a =
+    match a with
+    | Vide -> None
+    | Noeud (k', v', fg, fd) ->
+        if k = k' then Some v'
+        else if k < k' then get k fg
+        else get k fd
+
+  let rec keys =
+    let rec aux a ks =
+      match a with
+      | Vide -> ks
+      | Noeud (k, _, fg, fd) -> k :: aux fg (aux fd ks)
+    in
+    fun a -> aux a []
+end
+
+module Assoc : SAssoc with type key = string = AssocList
+
+module Factures = struct
+  type facture = (int * float) Assoc.t
+
+  let ajoute (article : string) (quantite : int) (prix : float)
+      (f : facture) : facture =
+    match Assoc.get article f with
+    | None -> Assoc.put article (quantite, prix) f
+    | Some (q', _) -> Assoc.put article (quantite + q', prix) f
+
+  let string_of_item fact article =
+    match Assoc.get article fact with
+    | None -> ""
+    | Some (qte, px) ->
+        article ^ "(" ^ string_of_int qte ^ "): "
+        ^ string_of_float px ^ "€"
+
+  let string_of_facture (f : facture) : string =
+    Assoc.keys f
+    |> List.map (string_of_item f)
+    |> List.fold_left (fun acc s -> acc ^ "\n" ^ s) ""
+end
+
+module Factures (Assoc : SAssoc with type key = string) = struct
+  type facture = (int * float) Assoc.t
+
+  let ajoute (article : string) (quantite : int) (prix : float)
+      (f : facture) : facture =
+    match Assoc.get article f with
+    | None -> Assoc.put article (quantite, prix) f
+    | Some (q', _) -> Assoc.put article (quantite + q', prix) f
+
+  let string_of_item fact article =
+    match Assoc.get article fact with
+    | None -> ""
+    | Some (qte, px) ->
+        article ^ "(" ^ string_of_int qte ^ "): "
+        ^ string_of_float px ^ "€"
+
+  let string_of_facture (f : facture) : string =
+    Assoc.keys f
+    |> List.map (string_of_item f)
+    |> List.fold_left (fun acc s -> acc ^ "\n" ^ s) ""
+end
+
+module FacturesTree = Factures (AssocTree)
+
+let _ =
+  FacturesTree.string_of_facture
+    (FacturesTree.ajoute "trombones" 100 0.01 AssocTree.empty)