#type périphérique = Clavier | Écran | Disque_dur;;
Le type périphérique est défini.
#type unité_centrale = { carte_mère: int; mémoire: int * int };;
Le type unité_centrale est défini.
#type machine = { uc: unité_centrale; périph: périphérique list };;
Le type machine est défini.

#let a_clavier pl = mem Clavier pl
 and a_écran pl = mem Écran pl
 and a_disque_dur pl = mem Disque_dur pl;;
a_clavier : périphérique list -> bool = <fun>
a_écran : périphérique list -> bool = <fun>
a_disque_dur : périphérique list -> bool = <fun>
#let liste_complète pl = a_clavier pl && a_écran pl && a_disque_dur pl;;
liste_complète : périphérique list -> bool = <fun>
#let compatibilité m =
   list_length m.périph <= m.uc.carte_mère ;;
compatibilité : machine -> bool = <fun>
#let mémoire_totale m = 
   match m.uc.mémoire with (nb, c) -> nb * c;;
mémoire_totale : machine -> int = <fun>

#type info_périphérique = 
   { nom_périph: périphérique; prix: int; quantité: int; seuil: int };;
Le type info_périphérique est défini.

#let rec info_périph nom stock = 
   match stock with
   | [] -> failwith "périph indisponible"
   | périph'::stock' -> 
       if périph'.nom_périph=nom then périph' else info_périph nom stock';;
info_périph : périphérique -> info_périphérique list -> info_périphérique =
 <fun>
#let prix_périph nom stock = (info_périph nom stock).prix;;
prix_périph : périphérique -> info_périphérique list -> int = <fun>
#let rec prix_lot lot stock =
   match lot with
   | [] -> 0
   | (tp, n) :: lot' -> 
       n *(prix_périph tp stock)+ prix_lot lot' stock;;
prix_lot : (périphérique * int) list -> info_périphérique list -> int = <fun>

#let rec mise_à_jour_périph nom quantité stock =
   match stock with
   | [] -> failwith "périph indisponible"
   | périph::stock' ->
       if périph.nom_périph = nom then
         { quantité = périph.quantité-quantité; 
           nom_périph = périph.nom_périph; 
           prix = périph.prix; seuil = périph.seuil } :: stock' 
       else
         périph::(mise_à_jour_périph nom quantité stock);;
mise_à_jour_périph :
 périphérique -> int -> info_périphérique list -> info_périphérique list =
 <fun>
#let rec mise_à_jour_lot lot stock =
   match lot with
   | [] -> stock
   | (nom, quantité)::lot' -> 
       mise_à_jour_lot lot' (mise_à_jour_périph nom quantité stock);;
mise_à_jour_lot :
 (périphérique * int) list -> info_périphérique list -> 'a list = <fun>

#let rec périphériques_à_commander stock =
   match stock with
   | [] -> []
   | {nom_périph = n; quantité = q; seuil = s} :: stock' ->
       if q < s
       then (n, s)::(périphériques_à_commander stock')
       else périphériques_à_commander stock';;
périphériques_à_commander :
 info_périphérique list -> (périphérique * int) list = <fun>

Ce document a été traduit de L^AT_EX par H^EV^EA.