Ce billet a pour but de tester la coloration du code OCaml sur Aerie's Guard. En grandeur nature.
Certains d'entre vous ont expérimenté avec Haskell.
Certains d'entre vous ont expérimenté avec OCaml ou suivent des cours OCaml.
Peut-être que certains d'entre vous suivent des cours Caml-Light.
Quoiqu'il en soit, avant de me lancer dans le grand bain, j'essaye d'abord le petit bassin.
En OCaml un module peut être un module-fonction, c'est-à-dire qu'il peut être paramétrable par un (ou plusieurs) module-argument(s) d'un certain module-type(s).
Donc la 1ière chose que nous allons faire c'est déclarer un module-type.
Il s'agit du type des ensembles totalement ordonnés implémentés comme des arbres binaires de recherche.
Mais on ne précise pas s'ils sont mutables ou immutables (on le fera plus tard).
1 2 3 4 5 6 7 8 9 10 11 12 13 | module type OrderedSet =
sig
type 'a set =
'a non_empty_set option
and 'a non_empty_set =
private
{ mutable left : 'a set ; item : 'a ; mutable right : 'a set }
val empty : 'a set
val make : 'a set - > 'a - > 'a set - > 'a non_empty_set
val with_left : 'a non_empty_set - > 'a set - > 'a non_empty_set
val with_right : 'a non_empty_set - > 'a set - > 'a non_empty_set
end
|
La 2ième chose c'est que l'on veut 2 modules-valeurs de ce module-type.
On veut un module-argument pour les ensembles totalement ordonnés immutables.
Spoiler Afficher/Masquer
1 2 3 4 5 6 7 8 9 10 11 12 | module PureOrderedSet : OrderedSet =
struct
type 'a set =
'a non_empty_set option
and 'a non_empty_set =
{ mutable left : 'a set ; item : 'a ; mutable right : 'a set }
let empty = None
let make l x r = { left = l ; item = x ; right = r }
let with_left s l = { s with left = l }
let with_right s r = { s with right = r }
end
|
On veut un module-argument pour les ensembles totalement ordonnés mutables.
Spoiler Afficher/Masquer
1 2 3 4 5 6 7 8 9 10 11 12 | module MutableOrderedSet : OrderedSet =
struct
type 'a set =
'a non_empty_set option
and 'a non_empty_set =
{ mutable left : 'a set ; item : 'a ; mutable right : 'a set }
let empty = None
let make l x r = { left = l ; item = x ; right = r }
let with_left s l = s . left < - l ; s
let with_right s r = s . right < - r ; s
end
|
La 3ième chose c'est que la récursion c'est compliqué. On peut se tromper et si on se trompe il faudra déboguer, soit parce que le calcul ne termine pas ou bien parce que la valeur retournée est incorrecte.
Déboguer c'est du temps perdu pour rien.
Alors on va régler le problème une fois pour toutes en encapsulant la récursion sur les ensembles totalement ordonnés.
Spoiler Afficher/Masquer
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | module OrderedSetRecursors ( S : OrderedSet ) =
struct
include S
type ( 'a , 'b ) fold =
< empty : 'a ; node : 'a - > 'b - > 'a - > 'a >
let rec fold s ( case : ( 'a , 'b ) fold ) =
match s with
| None - > case # empty
| Some n - > case # node ( fold n . left case ) n . item ( fold n . right case )
type ( 'a , 'b ) cata =
< empty : 'a ; node : ( unit - > 'a ) - > 'b - > ( unit - > 'a ) - > 'a >
let rec cata s ( case : ( 'a , 'b ) cata ) ( ) =
match s with
| None - > case # empty
| Some n - > case # node ( cata n . left case ) n . item ( cata n . right case )
type ( 'a , 'b ) recu =
< empty : 'b ;
node : 'a non_empty_set - > 'b - > 'b - > 'b >
let rec recu s ( case : ( 'a , 'b ) recu ) =
match s with
| None - >
case # empty
| Some n - >
case # node n ( recu n . left case ) ( recu n . right case )
type ( 'a , 'b ) para =
< empty : 'b ;
node : 'a non_empty_set - > ( unit - > 'b ) - > ( unit - > 'b ) - > 'b >
let rec para s ( case : ( 'a , 'b ) para ) ( ) =
match s with
| None - >
case # empty
| Some n - >
case # node n ( para n . left case ) ( para n . right case )
let para_non_empty n ( case : ( 'a , 'b ) para ) ( ) =
case # node n ( para n . left case ) ( para n . right case )
end
|

On veut une dernière chose :
Pouvoir créer des ensembles totalement ordonnés mutables ou immutables
Les équiper de toutes les opérations ensemblistes, à savoir e ∈ S, A ∪ B, A ∩ B, A ⊃ B, A - B, A = B, ∀ e ∈ S on a P(e), {e ∈ S, P(e)}
Que toutes ces opérations soient performantes, qu'elles utilisent le fait que les ensembles sont ordonnées. Par exemple il est hors de question d'ajouter les éléments de A un-par-un à l'ensemble B pour calculer A ∪ B.
Spoiler Afficher/Masquer
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | module MakeSet ( S : OrderedSet )
=
struct
include
OrderedSetRecursors ( S )
let cardinal s =
fold s (
object
method empty = 0
method node l _ r = l + 1 + r
end )
let for_all cond s =
cata s (
object
method empty = true
method node l y r =
l ( ) & & cond y & & r ( )
end ) ( )
let member x s =
cata s (
object
method empty = false
method node l y r =
if x < y then l ( )
else if x > y then r ( )
else true
end ) ( )
let insert x s =
para s (
object
method empty =
make None x None
method node n l r =
let y = n . item in
if x < y then with_left n ( Some ( l ( ) ) )
else if x > y then with_left n ( Some ( r ( ) ) )
else n
end ) ( )
let minimum s =
para_non_empty s (
object
method empty = s
method node n l r =
if n . left = empty then n
else l ( )
end ) ( )
let remove_minimum s =
para_non_empty s (
object
method empty = empty
method node n l r =
if n . left = empty then n . right
else Some ( with_left n ( l ( ) ) )
end ) ( )
let concat sa sb =
if sa = empty then sb else
match sb with
| None - > sa
| Some n - >
let m = minimum n
and r = remove_minimum n
in Some ( with_right ( with_left m sa ) r )
let remove x s =
para s (
object
method empty =
empty
method node n l r =
let y = n . item in
if x < y then Some ( with_left n ( l ( ) ) )
else if x > y then Some ( with_right n ( r ( ) ) )
else concat n . left n . right
end ) ( )
let split x s =
para s (
object
method empty =
empty , false , empty
method node n l r =
let y = n . item in
if x < y then
let a , b , c = l ( ) in
a , b , Some ( with_left n c )
else if x > y then
let a , b , c = r ( ) in
Some ( with_right n a ) , b , c
else
n . left , true , n . right
end ) ( )
let filter cond s =
recu s (
object
method empty =
empty
method node n l r =
if cond n . item then
Some ( with_right ( with_left n l ) r )
else
concat l r
end )
let union sa sb =
recu sa (
object
method empty s =
s
method node m l r s =
Some (
match s with
| None - > m
| Some n - >
let a , b , c = split m . item s in
with_right ( with_left m ( l a ) ) ( r c ) )
end ) sb
let intersection sa sb =
recu sa (
object
method empty s =
empty
method node m l r s =
match s with
| None - > empty
| Some n - >
let a , b , c = split m . item s in
if b then
Some ( with_right ( with_left m ( l a ) ) ( r c ) )
else
concat ( l a ) ( r c )
end ) sb
let difference sa sb =
recu sa (
object
method empty s =
empty
method node m l r s =
match s with
| None - >
Some m
| Some n - >
let a , b , c = split m . item s in
if b then
concat ( l a ) ( r c )
else
Some ( with_right ( with_left m ( l a ) ) ( r c ) )
end ) sb
let subset sa sb =
recu sa (
object
method empty s =
true
method node m l r s =
match s with
| None - > false
| Some n - >
if m . item < n . item then
( l n . left ) & & member m . item n . left & & ( r s )
else if m . item > n . item then
( l s ) & & member m . item n . right & & ( r n . right )
else
( l n . left ) & & ( r n . right )
end ) sb
let equal sa sb =
subset sa sb & & subset sb sa
end
|

Désormais, pour créer un module ensemble totalement ordonné immutable :
1 | module PSet = MakeSet ( PureOrderedSet )
|
Désormais, pour créer un module ensemble totalement ordonné mutable :
1 | module MSet = MakeSet ( MutableOrderedSet )
|
Les fonctions ont toutes le type approprié. Par exemple il est impossible de retirer un élément d'un ensemble vide parce que la fonction remove est du type :
1 | val remove : 'a - > 'a non_empty_set - > 'a set
|
Réciproquement, lorsque l'on insère un élément dans un ensemble quelconque, on obtient forcément un ensemble non vide :
1 | val insert : 'a - > 'a set - > 'a non_empty_set
|
J'ai du mal à comprendre le fond de cet article, mais je constate que la coloration syntaxique marche bien, c'est déjà ça
Pourtant, dans la source finale il y a tout plein de object ... method ..., ça devrait t'être familier
Tout ça c'est la forme, si je ne comprends pas l'intérêt du problème, je peux très bien reconnaître des structures de langage, ça ne m'aide pas pour autant
Ce code est une petite partie de mon projet MoonLib.
Ne déroule que le dernier Spoiler.
Que vois-tu :
Il n'y a aucune boucle while ou for ou autre.
Il n'y a aucun let rec c'est-à-dire qu'il n'y a pas de récursion.
Mais alors, quel est le paradigme utilisé par ce code ?
Ce que tu vois c'est la réalisation de ce qu'Alain Prouté décrit dans les 13 premières minutes de son intervention à la conférence Innovaxiom :
Le paradigme utilisé n'est tout simplement pas présent dans la liste à droite de la page Wikipedia.
à 12m45s. Alain Prouté prononce les mots "c'est exactement le langage des Catégories Bicartésiennes Fermées". Ça n'est pas véritablement de la programmation fonctionnelle au sens où ça n'est pas Turing-complet. Tu peux considérer ça comme un nouveau paradigme à ajouter à la page Wikipedia.